Merge branch 'dev' into object_sepmeth

Author: afgbloch

src/madl_element.mad

@@ -36,6 +36,8 @@ local Element = object 'element' {
   l_mag=\s s.l, l_elec=\s s.l, l_rad=\s s.l, l_mech=\s s.l,           -- aliases
 }
 
+-- identity -------------------------------------------------------------------o
+
 local _id = {}
 
 local function is_element (a)
@@ -46,8 +48,8 @@ end
 -- flags ----------------------------------------------------------------------o
 
 M.flags = {
-  implicit = Element.first_free_flag,               -- inherited from object
-  selected = Element.first_free_flag+1,
+  selected = Element.first_free_flag,
+  implicit = Element.first_free_flag+1,               -- inherited from object
   observe  = Element.first_free_flag+2,
   layout   = Element.first_free_flag+3,
   layangle = Element.first_free_flag+4,
@@ -57,13 +59,15 @@ Element.first_free_flag = Element.first_free_flag+5 -- overridden in Element
 
 -- members --------------------------------------------------------------------o
 
-local implicit, selected in M.flags
+local implicit, observe, selected in M.flags
 
 Element :set_methods {
-  is_implicit = \s   ->  test_flag(s,      implicit),
   is_selected = \s,f ->  test_flag(s, f or selected),
   select      = \s,f ->   set_flag(s, f or selected),
   deselect    = \s,f -> clear_flag(s, f or selected),
+  -- specializations
+  is_implicit = \s   ->  test_flag(s, implicit),
+  is_observed = \s   ->  test_flag(s, observe ),
 
 } :set_metamethods ({
   -- identity
@@ -169,10 +173,11 @@ M.vkicker.ksl = \s -> {   s. kick or s.vkick or 0  }
 
 -- env ------------------------------------------------------------------------o
 
-local is_implicit, is_selected in Element
+local is_implicit, is_observed, is_selected in Element
 
 MAD.typeid.is_element  = is_element
 MAD.typeid.is_implicit = is_implicit
+MAD.typeid.is_observed = is_observed
 MAD.typeid.is_selected = is_selected
 
 -- end ------------------------------------------------------------------------o

src/madl_gphys.mad

@@ -23,13 +23,14 @@
 
 -- locals ---------------------------------------------------------------------o
 
-local matrix                                                     in MAD
+local matrix, trace                                              in MAD
 local is_positive, is_matrix, is_cvector, wrestrict              in MAD.typeid
-local assertf                                                    in MAD.utility
+local assertf, num2str                                           in MAD.utility
 local twopi                                                      in MAD.constant
 local abs, sqrt, atan2 in math
 
-local dp_tol = 1e-12
+local dp_tol   = 1e-12
+local symp_tol = 1e-12
 
 -- helpers --------------------------------------------------------------------o
 
@@ -188,6 +189,11 @@ end
 function gphys.normal1 (R)
   chkeigsiz(R)
 
+  local symperr = R:symperr()
+--  if symperr > symp_tol then
+    trace(0, "symplectic deviation: %s", num2str(symperr))
+--  end
+
   -- get eigenvalues and eigenvectors of R
   local W, A, V, info = R:eigen()
 --  print("\ninfo=", info)
@@ -218,6 +224,9 @@ function gphys.normal1 (R)
   gphys.phas_eigen(A)
 --  A:print('A')
 
+  -- check one-turn-map normalisation
+  R :print('R') ; (1/A * R * A) :print('N = A^-1 R A ')
+
   return A, V, W, info
 end
 

src/madl_madx.mad

@@ -24,9 +24,9 @@
 -- locals ---------------------------------------------------------------------o
 
 local object, warn                                                in MAD
-local assertf                                                     in MAD.utility
+local assertf, openfile                                           in MAD.utility
 local bind1st                                                     in MAD.gfunc
-local is_nil, is_number, is_string, is_instanceOf                 in MAD.typeid
+local is_nil, is_number, is_string, is_callable, is_instanceOf    in MAD.typeid
 
 assert(is_nil(MADX), "MADX environment already defined")
 
@@ -229,14 +229,12 @@ end
   cls[elm] = cls_name : class of element
 ]]--
 
-local function load_file (madx, file_in, file_out)
+local function load2madx (madx, src, dst)
   assert(madx == MADX or is_instanceOf(madx, MADX), "invalid MADX environment")
-  assert(is_string(file_in)                       , "invalid input file name")
-  assert(is_string(file_out) or is_nil(file_out)  , "invalid ouput file name")
 
   -- compile directly in memory (no translation)
-  if string.sub(file_in, -4) == '.mad' then
-    MADX:load_env(file_in)
+  if is_callable(src) or is_string(src) and string.sub(src, -4) == '.mad' then
+    MADX:load_env(src)
     return
   end
 
@@ -246,10 +244,9 @@ local function load_file (madx, file_in, file_out)
                 wrn=madx.option.warn, madx=madx }
 
   -- load file
-  local inf = assert( io.open(file_in) )
+  local inf = openfile(src, 'r')
   local out = {
     string.format("-- Generated by MAD %s %s", MAD.env.version, os.date()),
---    string.format("%s:open_env()\n", madx.name),
   }
 
   for line in inf:lines() do
@@ -259,13 +256,13 @@ local function load_file (madx, file_in, file_out)
     line = convert_statements (env, line)
     out[#out+1] = line
   end
---  out[#out+1] = string.format("\n%s:close_env()", madx.name)
-  inf:close()
+  if is_string(src) then inf:close() else inf:flush() end
 
   -- save to file
-  if file_out then
-    local outf = assert( io.open(file_out, "w") )
+  if dst then
+    local outf = openfile(dst, 'w', '.mad')
     for i,s in ipairs(out) do outf:write(s, '\n') end
+    if is_string(dst) then outf:close() else outf:flush() end
   end
 
   -- compile in memory
@@ -279,7 +276,6 @@ end
 -- MADX helpers ---------------------------------------------------------------o
 
 local sinc        in MAD.gmath
-local is_callable in MAD.typeid
 
 --[[
 l_arc  = A*R
@@ -315,7 +311,7 @@ local MADX = object 'MADX' {
 
 -- load madx definition
 MADX:set_methods {
-  load = load_file,
+  load = load2madx,
 }
 
 -- math functions, see mad_dict.c from MAD-X source

src/madl_mtable.mad

@@ -642,12 +642,12 @@ local function range_of (tbl, rng_, ref_, dir_)
     stop , istop  = start, istart
   elseif is_string(rng_) then
     local s1, i2 = strsplit(rng_, "/" )
-    local s2 = i2 > 0 and strtrim(rng_, i2+1) or nil
+    local s2 = i2 == 0 and s1 or strtrim(rng_, i2+1)
     start, stop = s1, s2
   elseif is_range(rng_) then
     start, stop = rng_:ranges()
   elseif is_table(rng_) then
-    start, stop, ref_ = rng_[1], rng_[2], ref_ or rng_[3]
+    start, stop, ref_ = rng_[1], rng_[2] or rng_[1], ref_ or rng_[3]
   else error "invalid argument #2 (integer, string, table or range expected)"
   end
   if not is_number(rng_) then
@@ -763,6 +763,22 @@ local function set (tbl, row, col, val, cnt_)
   end
 end
 
+--- cleaning -------------------------------o
+
+local function clr_dat (tbl)
+  assert(is_mtable(tbl), "invalid argument #1 (mtable expected)")
+  local data = var_raw(tbl,_data)
+  assert(not (data.ro or tbl:is_readonly()), "invalid write access to readonly mtable")
+  for i=1,data.nc-data.ng do
+    if is_table(data[i])
+    then table.clear(data[i])
+    else data[i]:zeros():_reshapeto(0)
+    end
+  end
+  data.nr = 0
+  return tbl
+end
+
 --- columns -------------------------------o
 
 local function get_col (tbl, key)
@@ -1517,6 +1533,9 @@ mtable :set_methods {
   insrow       = ins_row,
   swprow       = swp_row,
 
+  -- clear all data, keep everything else
+  clrdat       = clr_dat,
+
   -- sequence-like methods
   name_of      = name_of,
   index_of     = index_of,

src/madl_plot.mad

@@ -98,6 +98,7 @@ local function plot_unlock (folder)
   end
   os.remove(tmplock)
   filesys.unlock(lock)
+  lock:close()
 end
 
 -- clear the list of handle of non-existing file
@@ -304,7 +305,7 @@ end
 
 local function teardown_cmd (self, file, fname)
   local scrdump, output in self
-  file:flush()
+  file:close()
   if output ~= false then
     gplot:printf("load('%s')", fname)
     if is_string(scrdump)

src/madl_sequence.mad

@@ -769,25 +769,26 @@ local function range_of (seq, rng_, ref_, dir_)
     elseif dir == -1 then return #seq, 1
     else error("invalid range direction (1 or -1 expected)")
     end
-  elseif is_integer(rng_) then
-    start, istart = rng_, index_of_idx(seq, rng_)
+  elseif is_number(rng_) then
+    start, istart = rng_, index_of_num(seq, rng_, dir_)
     stop , istop  = start, istart
   elseif is_string(rng_) then
     local s1, i2 = strsplit(rng_, "/")
-    local s2 = i2 > 0 and strtrim(rng_, i2+1) or nil
+    local s2 = i2 == 0 and s1 or strtrim(rng_, i2+1)
     doidx, start, stop = true, s1, s2
   elseif is_range(rng_) then
     doidx, start, stop, step = true, rng_:ranges()
     dir_ = dir_ or step
   elseif is_table(rng_) then
-    start, stop, ref_, dir_ = rng_[1], rng_[2], ref_ or rng_[3], dir_ or rng_[4]
+    start, stop, ref_, dir_ = rng_[1], rng_[2] or rng_[1], ref_ or rng_[3],
+                                                           dir_ or rng_[4]
     if ref_ == 'idx' then
       assert(is_integer(start) and is_integer(stop),
              "invalid argument #2 (range of integers expected)")
       istart, istop = index_of_idx(seq, start), index_of_idx(seq, stop)
     else doidx = true
     end
-  else error("invalid argument #2 (integer, string, table or range expected)")
+  else error("invalid argument #2 (number, string, table or range expected)")
   end
   local sstart, sstop
   if doidx then

src/madl_survey.mad

@@ -80,8 +80,14 @@ local function save_all (elm, mflw, lw_)
   atfill(elm, mflw, lw)
 end
 
-local function save_elm (elm, mflw, lw_)
-  if not is_implicit(elm) then save_all(elm, mflw, lw_) end
+local function save_imp (elm, mflw, lw_)
+  if is_implicit(elm) then return end
+  save_all(elm, mflw, lw_)
+end
+
+local function save_obs (elm, mflw, lw_)
+  if not is_observed(elm) then return end
+  save_all(elm, mflw, lw_)
 end
 
 local function make_mtable (self)
@@ -117,17 +123,20 @@ local function make_mflow (self)
   local iter, state, init = sequ:siter(range, nturn, sdir)
 
   -- build mtable
-  local save, nofill, implicit in self
+  local save, nofill, observe, implicit in self
   assert(is_boolean(save) or is_callable(save),
                                "invalid save (boolean or callable expected)")
   assert(is_boolean(nofill)  , "invalid nofill (boolean expected)")
+  assert(is_boolean(observe) , "invalid observe (boolean expected)")
   assert(is_boolean(implicit), "invalid implicit (boolean expected)")
 
   -- saving data
   local mtbl, fill
   if save then
     mtbl = make_mtable(self)
-    fill = is_callable(save) and save or implicit and save_all or save_elm
+    fill = is_callable(save) and save     or -- precedence matters!
+           observe  == true  and save_obs or
+           implicit == false and save_imp or save_all
   else
     fill = fnone
   end
@@ -238,33 +247,42 @@ local function exec (self)
   return mtbl, mflw
 end
 
-local survey = command 'survey' {
-  sequence=nil,   -- sequence (required)                                  (mflw)
-  range=nil,      -- range of tracking                                    (iter)
-  title=nil,      -- title of mtable                                      (mtbl)
-  sdir=1,         -- s-direction of tracking (1 or -1)                    (mflw)
-
-  s0=0,           -- initial s                                            (mflw)
-  X0={0,0,0},     -- initial coordinates x, y, z                          (mflw)
-  A0={0,0,0},     -- initial angles theta, phi, psi                       (mflw)
+local _na -- not applicable (see track or twiss)
 
-  nturn=1,        -- number of turns                                      (iter)
-  nstep=-1,       -- number of elements to track                          (iter)
-  nslice=1,       -- number of slice for each element                     (mflw)
-
-  save=true,      -- create mtable and set fill to save data              (mtbl)
-  nofill=false,   -- disable filling at the end of an element             (mflw)
-  implicit=true,  -- save also implicit elements                          (mtbl)
-
-  atentry=nil,    -- action to call when entering an element              (mflw)
-  atslice=nil,    -- action to call after each element slices             (mflw)
-  atexit=nil,     -- action to call when exiting an element               (mflw)
-  atfill=nil,     -- action to call when filling a mtable row             (mflw)
+local survey = command 'survey' {
+  beam=_na,         -- N/A                                                (mflw)
+  sequence=nil,     -- sequence (required)                                (mflw)
+  range=nil,        -- range of tracking                                  (iter)
+  title=nil,        -- title of mtable                                    (mtbl)
+  sdir=1,           -- s-direction of tracking (1 or -1)                  (mflw)
+
+  s0=0,             -- initial s                                          (mflw)
+  X0={0,0,0},       -- initial coordinates x, y, z                        (mflw)
+  A0={0,0,0},       -- initial angles theta, phi, psi                     (mflw)
+
+  mapdef=_na,       -- N/A                                                (mflw)
+  mapsave=false,    -- save W in the mtable                               (mflw)
+
+  nturn=1,          -- number of turns                                    (iter)
+  nstep=-1,         -- number of elements to track                        (iter)
+  nslice=1,         -- number of slice for each element                   (mflw)
+  method=_na,       -- N/A                                                (mflw)
+  totalpath=_na,    -- N/A                                                (mflw)
+
+  save=true,        -- create mtable and set fill to save data            (mtbl)
+  nofill=false,     -- disable filling at the end of an element           (mflw)
+  observe=false,    -- save only observed elements                        (mtbl)
+  implicit=true,    -- save also implicit elements                        (mtbl)
+
+  atentry=nil,      -- action to call when entering an element            (mflw)
+  atslice=nil,      -- action to call after each element slices           (mflw)
+  atexit=nil,       -- action to call when exiting an element             (mflw)
+  atfill=nil,       -- action to call when filling a mtable row           (mflw)
 
   mflow=nil,      -- current mflow, exclusive with other attributes except nstep
 
-  exec=exec,      -- command to execute upon children creation
-} :set_readonly() -- reference survey command is readonly
+  exec=exec,        -- command to execute upon children creation
+} :set_readonly()   -- reference survey command is readonly
 
 -- end ------------------------------------------------------------------------o
 return { survey = survey }