source: TRACY3/trunk/tracy/tracy/src/t2lat.cc @ 11

Last change on this file since 11 was 11, checked in by zhangj, 11 years ago
  • Property svn:executable set to *
File size: 123.9 KB
Line 
1/* Tracy-2
2
3J. Bengtsson, CBP, LBL      1990 - 1994   Pascal version
4              SLS, PSI      1995 - 1997
5M. Boege      SLS, PSI      1998          C translation
6L. Nadolski   SOLEIL        2002          Link to NAFF, Radia field maps
7J. Bengtsson  NSLS-II, BNL  2004 -       
8
9*/
10/* Current revision $Revision: 1.20 $
11 On branch $Name:  $
12 Latest change $Date: 2012/01/27 16:47:39 $ by $Author: zhang $
13*/
14
15
16#define NoBmax       200          // maximum number of blocks (NoB)
17#define NoBEmax      9000         /* maximum number of elements in
18                                     a block (Elem_NFam) */
19#define UDImax       100          // max number of user defined constants
20#define LatLLng      (132+1)
21#define Lat_nkw_max  200          // no. of key words
22
23// tables
24
25#define emax         322
26#define emin         (-292)
27#define kmax         15           // max no. of significant digits
28
29#define nmax         LONG_MAX
30
31#define nn           3                    // added by nsrl-ii
32#define tmax         100                  // added by nsrl-ii
33
34#define smax            600   /*size   of string table*/
35#define xmax            LONG_MAX   /*2**8 - 1*/
36
37typedef char Latlinetype[LatLLng];
38
39typedef enum
40{
41  bndsym, defsym, dfcsym, drfsym, elmsym, fcssym, horsym, versym,corkicksym, monsym,
42  qdsym, sexsym,  plus_, minus_, lparent, rparent, eql, comma, lbrack,
43  rbrack, neq, andsy, semicolon, times, rdiv, intcon, realcon, becomes, colon,
44  leq, pwrsym, lss, geo, gtr, period_, charcon, stringcon, ident, geq, lsym,
45  bobrhosym, bobrhovsym, bobrhohsym, kxvsym, kxhsym, phisym, ksym,
46  tsym, t1sym, t2sym,h1sym,h2sym,
47  gapsym, thksym, invsym, thnsym,
48  endsym, tsksym, bemsym, corsym, prnsym, tblsym, possym, prmsym,
49  udisym, squote, linsym, mthsym, celsym, matsym, cavsym, symsym, chmsym,
50  cctsym, usesym, andsym, dspsym, kicksym, wglsym, nsym, mrksym,
51  nbdsym, frgsym, latsym, mpsym, dbnsym, kssym, homsym, lmdsym, dtsym, xytsym,
52  vrfsym, harnumsym, frqsym, gstsym, typsym, rollsym, idsym,
53  fnamesym1, fnamesym2, scalingsym1, scalingsym2, fmsym, harmsym, sprsym, recsym, solsym,edge_effect1sym,edge_effect2sym,
54  ff1sym, ff2sym, ffscalingsym, tiltsym
55} Lat_symbol;   /*\*/
56// idsym fnamesym1 fnamesym2 scalingsym added for insertion
57// ring sym added
58  //edge_effect1sym, edge_effect2sym added, to turn on/off the edge effect of dipoles @ 05/10/2012 by Jianfeng Zhang
59// ff1sym ff2sym for quadrupole entrance and exit fringe field
60// ffscalingsym scaling factor for entrance and exit fringe field.  /*J.Zhang
61// tilt added for compatibility with Tracy II
62/* p2c: t2lat.pas, line 52:
63 * Note: Line breaker spent 0.0 seconds, 5000 tries on line 603 [251] */
64
65
66//#define SETBITS  (8*(unsigned)sizeof(long int))
67#define SETBITS  32  /* Length of set is assumed to be 32,
68                        see e.g. DealWithDefns             */
69
70const int  max_set = (solsym-bndsym+1)/SETBITS + 2;
71
72// array for set
73typedef long int  symset[max_set];
74
75typedef  alfa_       Lat_keytype[Lat_nkw_max];
76typedef  Lat_symbol  Lat_ksytype[Lat_nkw_max];
77typedef  Lat_symbol  Lat_spstype[256];
78
79typedef struct _REC_BlockStype
80{
81  partsName Bname;   /* name of a beam line */
82  long  BSTART, BOWARI;
83} _REC_BlockStype;
84
85typedef _REC_BlockStype BlockStype[NoBmax];
86
87typedef long index_;
88
89typedef enum {
90  notyp, ints, reals, bools, chars, arrays, records
91} types;
92
93typedef long typset;
94
95typedef struct _REC_UDItable {
96  partsName  Uname;
97  double     Uvalue;
98} _REC_UDItable;
99
100
101//* Local variables for Lattice_Read: */
102struct LOC_Lattice_Read
103{
104  FILE     **fi, **fo;
105  jmp_buf  _JL9999;
106  long     Symmetry;
107  bool     Ring;    /* true is CELL is a ring */
108
109  long  NoB;        /* Number of defined Blocks */
110  BlockStype BlockS;
111
112  long  Bstack[NoBEmax];
113  long  Bpointer;
114
115  long  UDIC;       /* Number of user defined constants */
116  _REC_UDItable UDItable[UDImax];
117
118  long         nkw;    /* number of key word */
119  Lat_symbol   sym;    /* last symbol read by GetSym*/
120  alfa_        id;     /* identifier from GetSym*/
121  long         inum;   /* integer from GetSym*/
122  double       rnum;   /* double number from GetSym*/
123  char         chin;   /* last character read from source program*/
124  long         cc;     /* character counter*/
125  long         lc;     /* program location counter*/
126  long         ll;     /* length of current line*/
127  long         errpos;
128  Latlinetype  line;
129
130  Lat_keytype  key;
131  Lat_ksytype  ksy;
132  Lat_spstype  sps;
133
134  symset       defbegsys, elmbegsys;
135  bool         skipflag, rsvwd;
136};
137
138
139// Set operations
140
141// val IN s
142int P_inset(register unsigned val, register long *s)
143{
144  register unsigned  bit;
145
146  bit = val % SETBITS; val /= SETBITS;
147  if (val < (unsigned)*s++ && ((1L<<bit) & (unsigned)s[val]))
148    return 1;
149  return 0;
150}
151
152
153// s := s + [val]
154long *P_addset(register long *s, register unsigned val)
155{
156  register long      *sbase = s;
157  register unsigned  bit, size;
158
159  bit = val % SETBITS; val /= SETBITS; size = *s;
160  if (++val > size) {
161    s += size;
162    while (val > size)
163      *++s = 0, size++;
164    *sbase = size;
165  } else
166    s += val;
167  *s |= 1L<<bit;
168  if (size+1 > (unsigned)max_set) {
169    cout << "P_addset: size+1 > max_set " << size+1
170         << "(" << max_set << ")" << endl;
171    exit_(1);
172  }
173  return sbase;
174}
175
176
177// d := s
178long *P_expset(register long *d, register long s)
179{
180  if (s) {
181    d[1] = s;
182    *d = 1;
183  } else
184    *d = 0;
185  return d;
186}
187
188
189// d := s1 + s2
190long *P_setunion(register long *d, register long *s1, register long *s2)
191{
192  long          *dbase = d++;
193  register int  sz1 = *s1++, sz2 = *s2++;
194 
195 while (sz1 > 0 && sz2 > 0) {
196    *d++ = *s1++ | *s2++;
197    sz1--, sz2--;
198  }
199  while (--sz1 >= 0)
200    *d++ = *s1++;
201  while (--sz2 >= 0)
202    *d++ = *s2++;
203  *dbase = d - dbase - 1;
204  return dbase;
205}
206
207
208static long CheckElementtable(const char *name, struct LOC_Lattice_Read *LINK)
209{
210  /* globval.Elem_nFam = Number of parts in a Element */
211  long  i, j, FORLIM;
212
213  j = 0;
214  if (globval.Elem_nFam > Elem_nFamMax) {
215    printf("Elem_nFamMax exceeded: %ld(%d)\n",
216           globval.Elem_nFam, Elem_nFamMax);
217    exit_(1);
218  }
219
220  //  if (strstr(LINK->line,"insertion") != NULL) return 0;
221
222  FORLIM = globval.Elem_nFam;
223  for (i = 1; i <= FORLIM; i++) {
224    if (!strncmp(ElemFam[i-1].ElemF.PName, name, sizeof(partsName)))
225      j = i;
226  }
227  return j;
228}
229
230
231static long CheckBLOCKStable(const char *name, struct LOC_Lattice_Read *LINK)
232{
233  /* NoB = Number of Block defs */
234  long  i, j, FORLIM;
235
236  j = 0;
237  if (LINK->NoB > NoBmax) {
238    printf("** NoBmax exhausted: %ld(%ld)\n", LINK->NoB, (long)NoBmax);
239    return j;
240  }
241  //  if (strstr(LINK->line,"insertion") != NULL) return 0;
242
243  FORLIM = LINK->NoB;
244  for (i = 1; i <= FORLIM; i++) {
245    if (!strncmp(LINK->BlockS[i - 1].Bname, name, sizeof(partsName)))
246      j = i;
247  }
248  return j;
249}
250
251
252//static void InitUDItable(struct LOC_Lattice_Read *LINK)
253//{
254//  LINK->UDIC = 0;
255//}
256
257
258static long CheckUDItable(const char *name, struct LOC_Lattice_Read *LINK)
259{
260  long  i, j, FORLIM;
261
262  j = 0;
263  if (LINK->UDIC > UDImax) {
264    printf("** UDImax exhausted: %ld(%d)\n", LINK->UDIC, UDImax);
265    exit_(1);
266    return j;
267  }
268  FORLIM = LINK->UDIC;
269  for (i = 1L; i <= FORLIM; i++) {
270    if (!strncmp(LINK->UDItable[i - 1L].Uname, name, sizeof(partsName)))
271      j = i;
272  }
273  return j;
274}
275
276
277static void EnterUDItable(const char *name, double X, struct LOC_Lattice_Read *LINK)
278{
279  _REC_UDItable  *WITH;
280
281  LINK->UDIC++;
282  if (LINK->UDIC > UDImax) {
283    printf("** UDImax exhausted: %ld(%d)\n", LINK->UDIC, UDImax);
284    exit_(1);
285    return;
286  }
287  WITH = &LINK->UDItable[LINK->UDIC - 1];
288  memcpy(WITH->Uname, name, sizeof(partsName));
289  WITH->Uvalue = X;
290}
291
292
293static void ModUDItable(long N, double X, struct LOC_Lattice_Read *LINK)
294{
295  _REC_UDItable *WITH;
296
297  WITH = &LINK->UDItable[N - 1];
298  WITH->Uvalue = X;
299}
300
301
302static void RefUDItable(const char *name, double *X, struct LOC_Lattice_Read *LINK)
303{
304  long k;
305
306  k = CheckUDItable(name, LINK);
307  *X = LINK->UDItable[k - 1].Uvalue;
308}
309
310
311//static void PrintUpname(char *name, struct LOC_Lattice_Read *LINK)
312//{
313//  /*(var name:partsname)*/
314//  long i;
315//  char ch;
316//
317//  for (i = 0; i < NameLength; i++) {
318//    ch = name[i];
319//    if ('a' <= ch && ch <= 'z')
320//      ch = _toupper(ch);
321//    putc(ch, *LINK->fo);
322//  }
323//}
324
325
326//static void PrintUpname1(char *name, long *pos,
327//                         struct LOC_Lattice_Read *LINK)
328//{  /*1*/
329//  /*var name : partsname; var pos : integer*/
330//  long i;
331//  char ch;
332//
333//  *pos = 0;
334//  for (i = 0; i < NameLength; i++) {  /*2*/
335//    ch = name[i];
336//    if ('a' <= ch && ch <= 'z')
337//      ch = _toupper(ch);
338//    if (ch != ' ') {
339//      putc(ch, *LINK->fo);
340//      (*pos)++;
341//    }
342//  }  /*2*/
343//}  /*1*/
344
345//void PrintUpname2(char *name, struct LOC_Lattice_Read *LINK)
346//{
347//  /*(var name:partsname)*/
348//  long i;
349//  char ch;
350//
351//  for (i = 0; i < NameLength; i++) {
352//    ch = name[i];
353//    if ('a' <= ch && ch <= 'z')
354//      ch = _toupper(ch);
355//    putc(ch, *LINK->fo);
356//  }
357//}
358
359
360static void abort_(struct LOC_Lattice_Read *LINK)
361{
362  long i;
363
364  for (i = 1; i <= nn; i++)
365    putchar('\007');
366  printf("\n>>>>> error detected in the lattice file <<<<<<\n\n");
367  ErrFlag = true;
368  /*goto 9999*/
369//  printf("% .5E\n", sqrt(-1.0));
370  exit_(1);
371}
372
373
374static void ENDskip(FILE **fo, long *errpos, long *cc, bool *skipflag,
375                    struct LOC_Lattice_Read *LINK)
376{
377  /*underline skips part of input*/
378  while (*errpos < *cc) {
379    putc('-', *fo);
380    (*errpos)++;
381  }
382  *skipflag = false;
383}
384
385
386static void Lat_Error(long n, FILE **fo, long *cc, long *errpos,
387                      struct LOC_Lattice_Read *LINK)
388{
389  if (*errpos != 0L)   /*write(fo, ' ****')*/
390    return;
391  if (*cc > *errpos) {
392    fprintf(*fo, "%*c^%2ld", (int)(*cc - *errpos), ' ', n);
393    *errpos = *cc + 3;
394  }
395}
396
397
398static void Lat_Nextch(FILE **fi, FILE **fo, long *cc, long *ll, long *errpos,
399                       long *lc, char *chin, bool *skipflag, char *line,
400                       struct LOC_Lattice_Read *LINK)
401{
402  if (*cc == *ll) {
403    if (P_eof(*fi)) {
404      fprintf(*fo, "\nprogram incomplete\n");
405      /*errormsg;*/
406      abort_(LINK);
407    }
408
409    if (*errpos != 0) {
410      if (*skipflag)
411        ENDskip(fo, errpos, cc, skipflag, LINK);
412      putc('\n', *fo);
413      *errpos = 0;
414    }
415    /* write(fo, */
416    /*lc: 5, */
417    /* '  ');*/
418    (*lc)++;
419
420    *ll = 0;
421    *cc = 0;
422
423    while (!P_eoln(*fi)) {
424      (*ll)++;
425      if ((*ll) > LatLLng) {
426        printf("Lat_Nextch: LatLLng exceeded %ld (%d)\n", (*ll)-1, LatLLng-1);
427        exit_(1);
428      }
429      *chin = getc(*fi);
430      if (*chin == '\n')
431        *chin = ' ';
432      putc(*chin, *fo);
433      line[*ll - 1] = *chin;
434    }
435    (*ll)++;
436    fscanf(*fi, "%*[^\n]");
437
438    getc(*fi);
439    line[*ll - 1] = ' ';
440    /*read(fi, line[ll]);*/
441    putc('\n', *fo);
442  }
443  (*cc)++;
444  if ((*cc) > LatLLng) {
445    printf("Lat_Nextch: LatLLng exceeded %ld (%d)\n", (*cc), LatLLng);
446    exit_(1);
447  }
448  *chin = line[*cc - 1];
449  /* upper case to lower case */
450  if (isupper(*chin))
451    *chin = _tolower(*chin);
452  /* tab */
453  if (*chin == '\t')
454    *chin = ' ';
455}  /* Lat_Nextch */
456
457
458static void Lat_errorm(const char *cmnt, FILE **fi, FILE **fo, long *cc,
459                       long *ll, long *errpos, long *lc, char *chin,
460                       bool *skipflag, char *line,
461                       struct LOC_Lattice_Read *LINK)
462{
463  /*write(fo, ' ****')*/
464  if (*cc > *errpos) {
465    fprintf(*fo, "%*c^%.80s", (int)(*cc - *errpos), ' ', cmnt);
466    *errpos = *cc + 3;
467  }
468  while (!P_eof(*fi))
469    Lat_Nextch(fi, fo, cc, ll, errpos, lc, chin, skipflag, line, LINK);
470  ErrFlag = true;
471  abort_(LINK);
472}
473
474/* Local variables for Lat_GetSym: */
475struct LOC_Lat_GetSym
476{
477  struct LOC_Lattice_Read  *LINK;
478  FILE    **fi, **fo;
479  long    *cc, *ll, *errpos, *lc, emax_, emin_;
480  char    *chin;
481  double  *rnum;
482  bool    *skipflag;
483  char    *line;
484  long    k, e;
485};
486
487
488static void NextCh(struct LOC_Lat_GetSym *LINK)
489{
490  Lat_Nextch(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos, LINK->lc,
491             LINK->chin, LINK->skipflag, LINK->line, LINK->LINK);
492}
493
494
495static void readscale(struct LOC_Lat_GetSym *LINK)
496{
497  long s, sign;
498
499  /* readscale  */
500  NextCh(LINK);
501  while (*LINK->chin == ' ')
502    NextCh(LINK);
503  sign = 1;
504  s = 0;
505  if (*LINK->chin == '+')
506    NextCh(LINK);
507  else if (*LINK->chin == '-') {
508    NextCh(LINK);
509    sign = -1;
510  }
511  if (!isdigit(*LINK->chin))
512    Lat_Error(40, LINK->fo, LINK->cc, LINK->errpos, LINK->LINK);
513  else {
514    do {
515      s = s * 10 + *LINK->chin - '0';
516      NextCh(LINK);
517    }
518    while (isdigit(*LINK->chin));
519  }
520  LINK->e += s * sign;
521}
522
523
524static void adjustscale(struct LOC_Lat_GetSym *LINK)
525{
526  long s;
527  double d, t;
528
529  /*  adjustscale  */
530  if (LINK->k + LINK->e > LINK->emax_) {
531    Lat_Error(21, LINK->fo, LINK->cc, LINK->errpos, LINK->LINK);
532    return;
533  }
534  if (LINK->k + LINK->e < LINK->emin_) {
535    *LINK->rnum = 0.0;
536    return;
537  }
538  s = abs(LINK->e);
539  t = 1.0;
540  d = 10.0;
541  do {
542    while (!(s & 1)) {
543      s /= 2;
544      d *= d;
545    }
546    s--;
547    t = d * t;
548  }
549  while (s != 0);
550
551  if (LINK->e >= 0)
552    *LINK->rnum *= t;
553  else
554    *LINK->rnum /= t;
555}
556
557
558static void Lat_GetSym(FILE **fi_, FILE **fo_, long *cc_, long *ll_,
559                       long *errpos_, long *lc_, long *nkw, long *inum,
560                       long emax__, long emin__, long kmax_, long nmax_,
561                       char *chin_, char *id, double *rnum_, bool *skipflag_,
562                       bool *rsvwd, char *line_, Lat_symbol *sym, alfa_ *key,
563                       Lat_symbol *ksy, Lat_symbol *sps,
564                       struct LOC_Lattice_Read *LINK)
565{  /*GetSym*/
566  struct LOC_Lat_GetSym V;
567
568  long i, j, mysign;
569  bool parsename;
570
571
572  V.LINK = LINK;
573  /*GetSym*/
574  V.fi = fi_;
575  V.fo = fo_;
576  V.cc = cc_;
577  V.ll = ll_;
578  V.errpos = errpos_;
579  V.lc = lc_;
580  V.emax_ = emax__;
581  V.emin_ = emin__;
582  V.chin = chin_;
583  V.rnum = rnum_;
584  V.skipflag = skipflag_;
585  V.line = line_;
586  *rsvwd = false;
587  mysign = 1;
588  parsename = false;
589 _L1:
590  while (*V.chin == ' ')
591
592    NextCh(&V);
593
594  switch (*V.chin) {
595
596  case 'a':
597  case 'b':
598  case 'c':
599  case 'd':
600  case 'e':
601  case 'f':
602  case 'g':
603  case 'h':
604  case 'i':
605  case 'j':
606  case 'k':
607  case 'l':
608  case 'm':
609  case 'n':
610  case 'o':
611  case 'p':
612  case 'q':
613  case 'r':
614  case 's':
615  case 't':
616  case 'u':
617  case 'v':
618  case 'w':
619  case 'x':
620  case 'y':
621  case 'z':
622  case '"':  /*identifier or wordsymbol*/
623    V.k = 0;
624    memcpy(id, "               ", sizeof(alfa_));
625    do {
626      if (*V.chin == '"')
627        parsename = !parsename;
628      if (V.k < NameLength) {
629        V.k++; id[V.k - 1] = *V.chin;
630      } else {
631        printf("In Lat_GetSym, symbol: %s too long, max value is %d\n",
632                id, NameLength);
633        exit_(1);
634      }
635      NextCh(&V);
636    } while (parsename || *V.chin == '_' || islower(*V.chin) ||
637             isdigit(*V.chin));
638
639    /*writeln(fo, 'GetSym detected: id=', id);*/
640
641    i = 1;
642    j = *nkw;   /*binary search*/
643    do {
644      V.k = (i + j) / 2;
645      if (strncmp(id, key[V.k - 1], sizeof(alfa_)) <= 0)
646        j = V.k - 1;
647      if (strncmp(id, key[V.k - 1], sizeof(alfa_)) >= 0)
648        i = V.k + 1;
649      /*  writeln(fo, '  bunary: id=', id, '  key[', k:3, ']=', key[k],
650          'i=', i:4, ' j=', j:4, ' k=', k:4, ' i-1-j=', (i-1-j):4);*/
651    }
652    while (i <= j);
653    if (i - 1 > j) {
654      *sym = ksy[V.k - 1]; *rsvwd = true;
655      /*  writeln(fo, 'GetSym detected reserved word: id=', id,
656          '  k=', k:4, '  key[', k:4, ']=', key[k]);*/
657    } else {
658      if (!strncmp(id, "t              ", sizeof(alfa_)))
659        *sym = tsym;
660      else if (!strncmp(id, "h1            ", sizeof(alfa_)))
661        *sym = h1sym;
662      else if (!strncmp(id, "h2            ", sizeof(alfa_)))
663        *sym = h2sym;
664      else if (!strncmp(id, "gap            ", sizeof(alfa_)))
665        *sym = gapsym;
666      else if (!strncmp(id, "l              ", sizeof(alfa_)))
667        *sym = lsym;
668      else if (!strncmp(id, "n              ", sizeof(alfa_)))
669        *sym = nsym;
670      else if (!strncmp(id, "bobrho         ", sizeof(alfa_)))
671        *sym = bobrhosym;
672      else if (!strncmp(id, "bobrhov        ", sizeof(alfa_)))
673        *sym = bobrhovsym;
674      else if (!strncmp(id, "bobrhoh        ", sizeof(alfa_)))
675        *sym = bobrhohsym;
676      else if (!strncmp(id, "kxv            ", sizeof(alfa_)))
677        *sym = kxvsym;
678      else if (!strncmp(id, "kxh            ", sizeof(alfa_)))
679        *sym = kxhsym;
680      else if (!strncmp(id, "phi            ", sizeof(alfa_)))
681        *sym = phisym;
682      else if (!strncmp(id, "k              ", sizeof(alfa_)))
683        *sym = ksym;
684      else if (!strncmp(id, "harnum         ", sizeof(alfa_)))
685        *sym = harnumsym;
686      else
687        *sym = ident;
688    }
689    break;
690
691  case '0':
692  case '1':
693  case '2':
694  case '3':
695  case '4':
696  case '5':
697  case '6':
698  case '7':
699  case '8':
700  case '9':  /*number*/
701    V.k = 0;
702    *inum = 0;
703    *sym = intcon;
704    do {
705      *inum = *inum * 10 + *V.chin - '0';
706      V.k++;
707      NextCh(&V);
708    }
709    while (isdigit(*V.chin));
710    if (V.k > kmax_ || *inum > nmax_) {
711      Lat_Error(21, V.fo, V.cc, V.errpos, LINK);
712      *inum = 0;
713      V.k = 0;
714    }
715    if (*V.chin == '.') {
716      NextCh(&V);
717      if (*V.chin == '.')
718        *V.chin = ':';
719      else {
720        *sym = realcon;
721        *V.rnum = *inum;
722        V.e = 0;
723        while (isdigit(*V.chin)) {
724          V.e--;
725          *V.rnum = 10.0 * *V.rnum + *V.chin - '0';
726          NextCh(&V);
727        }
728        while (*V.chin == ' ')
729          NextCh(&V);
730        if (V.e == 0)
731          Lat_Error(40, V.fo, V.cc, V.errpos, LINK);
732        if (*V.chin == 'd' || *V.chin == 'D' || *V.chin == 'e' ||
733            *V.chin == 'E')
734          readscale(&V);
735        if (V.e != 0)
736          adjustscale(&V);
737      }
738    } else {
739      if (*V.chin == 'd' || *V.chin == 'D' || *V.chin == 'e' ||
740          *V.chin == 'E') {
741        *sym = realcon;
742        *V.rnum = *inum;
743        V.e = 0;
744        readscale(&V);
745        if (V.e != 0)
746          adjustscale(&V);
747      }
748    }
749    if (*sym == intcon)
750      *inum *= mysign;
751    else {
752      if (*sym == realcon)
753        *V.rnum = mysign * *V.rnum;
754    }
755    break;
756
757  case ':':   /*, col*/
758    NextCh(&V);
759    if (*V.chin == '=') {
760      *sym = becomes;
761      NextCh(&V);
762    }
763    else
764      *sym = colon;
765    break;
766
767  case '<':
768    NextCh(&V);
769    if (*V.chin == '=')
770      {
771        *sym = leq;
772        NextCh(&V);
773      }
774    else {
775      if (*V.chin == '>') {
776        *sym = neq;
777        NextCh(&V);
778      }
779      else
780        *sym = lss;
781    }
782    break;
783
784  case '>':
785    NextCh(&V);
786    if (*V.chin == '=') {
787      *sym = geq;
788      NextCh(&V);
789    }
790    else
791      *sym = gtr;
792    break;
793
794  case '.':
795    NextCh(&V);
796    *sym = period_;
797    break;
798
799  case '*':
800    NextCh(&V);
801    if (*V.chin == '*') {
802      *sym = pwrsym;
803      NextCh(&V);
804    }
805    else
806      *sym = times;
807    break;
808
809  case '{':
810    do {
811      NextCh(&V);
812    }
813    while (*V.chin != '}');
814    NextCh(&V);
815    goto _L1;
816    break;
817
818  case '+':
819  case '-':
820  case '/':
821  case '(':
822  case ')':
823  case '=':
824  case ',':
825  case ';':
826  case '[':
827  case ']':
828  case '\'':
829    *sym = sps[*V.chin];
830    /* IF chin='+' THEN BEGIN nextch; goto 1 END ELSE
831       IF chin='-' THEN BEGIN nextch; mysign:=-1; goto 1 END ELSE*/
832    NextCh(&V);
833    break;
834
835  case '$':
836  case '!':
837  case '@':
838  case '?':
839  case '_':
840  case '&':
841  case '\\':
842  case '^':
843    Lat_Error(24L, V.fo, V.cc, V.errpos, LINK);
844    NextCh(&V);
845    goto _L1;
846    break;
847
848  default:
849    Lat_Error(24L, V.fo, V.cc, V.errpos, LINK);
850    NextCh(&V);
851    goto _L1;
852    break;
853  }
854}
855
856/* Local variables for Lat_EVAL: */
857struct LOC_Lat_EVAL
858{
859  struct LOC_Lattice_Read *LINK;
860  FILE **fi, **fo;
861  long *cc, *ll, *errpos, *lc, *nkw, *inum, emax_, emin_, kmax_, nmax_;
862  char *chin;
863  char *id;
864  double *rnum;
865  bool *skipflag, *rsvwd;
866  char *line;
867  Lat_symbol *sym;
868  alfa_ *key;
869  Lat_symbol *ksy;
870  Lat_symbol *sps;
871  jmp_buf _JL999;
872
873  double S[tmax + 1];
874  long t;
875  symset facbegsys;
876};
877
878static void Expression(struct LOC_Lat_EVAL *LINK);
879
880
881static void GetSym(struct LOC_Lat_EVAL *LINK)
882{
883  /* reads next symbol  */
884  Lat_GetSym(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos, LINK->lc,
885             LINK->nkw, LINK->inum, LINK->emax_, LINK->emin_, LINK->kmax_,
886             LINK->nmax_, LINK->chin, LINK->id, LINK->rnum, LINK->skipflag,
887             LINK->rsvwd, LINK->line, LINK->sym, LINK->key, LINK->ksy,
888             LINK->sps, LINK->LINK);
889}
890
891
892static void errorm(const char *cmnt, struct LOC_Lat_EVAL *LINK)
893{
894  Lat_errorm(cmnt, LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
895             LINK->lc, LINK->chin, LINK->skipflag, LINK->line, LINK->LINK);
896}
897
898static void test(long *s1, const char *cmnt, struct LOC_Lat_EVAL *LINK)
899{
900  if (!P_inset(*LINK->sym, s1))
901    errorm(cmnt, LINK);
902}
903
904
905static void getest(long *s1, const char *cmnt, struct LOC_Lat_EVAL *LINK)
906{
907  GetSym(LINK);
908  if (!P_inset(*LINK->sym, s1))
909    errorm(cmnt, LINK);
910}
911
912
913static double ArcSin(double x, struct LOC_Lat_EVAL *LINK)
914{
915  if (fabs(x) > 1e0)
916    longjmp(LINK->_JL999, 1);
917  if (x == 1e0)
918    return (M_PI / 2e0);
919  else if (x == -1e0)
920    return (M_PI / -2e0);
921  else
922    return atan(x / sqrt(1e0 - x * x));
923}
924
925
926static double ArcCos(double x, struct LOC_Lat_EVAL *LINK)
927{
928  if (fabs(x) > 1e0)
929    longjmp(LINK->_JL999, 1);
930  if (x == 1e0)
931    return 0e0;
932  else if (x == -1e0)
933    return M_PI;
934  else
935    return atan(sqrt(1e0 - x * x) / x);
936}
937
938
939static void writes(struct LOC_Lat_EVAL *LINK)
940{
941  /*writeln('PUSH:  s[', t:3, ']=', s[t]);*/
942}
943
944
945static void PUSH(double x, struct LOC_Lat_EVAL *LINK)
946{
947  LINK->t++;
948  if (LINK->t == tmax)
949    {
950      printf("** Lat_Eval: stack overflow\n");
951      longjmp(LINK->_JL999, 1);
952    }
953  LINK->S[LINK->t] = x;
954  writes(LINK);
955}
956
957
958static double BlockLength(long ii, struct LOC_Lat_EVAL *LINK)
959{
960  long    k1, k2, k3;
961  double  S;
962
963  S = 0.0;
964  if (ii == 0)
965    return S;
966  k2 = LINK->LINK->BlockS[ii - 1].BSTART;
967  k3 = LINK->LINK->BlockS[ii - 1].BOWARI;
968  for (k1 = k2 - 1; k1 < k3; k1++)
969    S += ElemFam[LINK->LINK->Bstack[k1] - 1].ElemF.PL;
970  return S;
971}
972
973/* Local variables for Expression: */
974struct LOC_Expression
975{
976  struct LOC_Lat_EVAL *LINK;
977};
978
979/* Local variables for Term: */
980struct LOC_Term
981{
982  struct LOC_Expression *LINK;
983};
984
985/* Local variables for Factor: */
986struct LOC_Factor
987{
988  struct LOC_Term *LINK;
989  long i;
990};
991
992
993static double GetKparm(long direction, struct LOC_Factor *LINK)
994{
995  double Result;
996  symset SET;
997
998  getest(P_expset(SET, 1 << ((long)lbrack)), "<[> expected",
999         LINK->LINK->LINK->LINK);
1000  GetSym(LINK->LINK->LINK->LINK);
1001  Expression(LINK->LINK->LINK->LINK);
1002  test(P_expset(SET, 1 << ((long)rbrack)), "<]> expected",
1003       LINK->LINK->LINK->LINK);
1004  if (direction == 1)
1005    Result = ElemFam[LINK->i-1].ElemF.M->PBpar[(long)((long)LINK->
1006             LINK->LINK->LINK->S[LINK->LINK->LINK->LINK->t])+HOMmax];
1007  else
1008    Result = ElemFam[LINK->i-1].ElemF.M->PBpar[HOMmax-(long)LINK->
1009            LINK->LINK->LINK->S[LINK->LINK->LINK->LINK->t]];
1010  LINK->LINK->LINK->LINK->t--;
1011  /* GetSym;*/
1012  return Result;
1013}
1014
1015
1016static void Factor(struct LOC_Term *LINK)
1017{
1018  struct LOC_Factor V;
1019  double x = 0.0;
1020  partsName fname;
1021  long SET[(long)period_ / 32 + 2];
1022  elemtype *WITH;
1023  MpoleType *WITH1;
1024  symset SET1;
1025  long SET2[(long)lsym / 32 + 2];
1026
1027  V.LINK = LINK;
1028  /* factor */
1029  if (!P_inset(*LINK->LINK->LINK->sym, LINK->LINK->LINK->facbegsys))
1030    longjmp(LINK->LINK->LINK->_JL999, 1);
1031  /*while sym in facbegsys do*/
1032  if (*LINK->LINK->LINK->sym == ident) {  /*1:  of ident */
1033    V.i = CheckUDItable(LINK->LINK->LINK->id, LINK->LINK->LINK->LINK);
1034    if (V.i != 0) {   /* UDI */
1035      x = LINK->LINK->LINK->LINK->UDItable[V.i - 1].Uvalue;
1036      PUSH(x, LINK->LINK->LINK);
1037      GetSym(LINK->LINK->LINK);
1038    } else {
1039      V.i = CheckElementtable(LINK->LINK->LINK->id, LINK->LINK->LINK->LINK);
1040      if (V.i != 0) {
1041        getest(P_addset(P_expset(SET, 0), (long)period_), "<.> expected",
1042               LINK->LINK->LINK);
1043        /*--> new */
1044        GetSym(LINK->LINK->LINK);
1045        memcpy(fname, LINK->LINK->LINK->id, sizeof(alfa_));
1046        memset(fname + sizeof(alfa_), ' ',
1047               sizeof(partsName) - sizeof(alfa_));
1048        WITH = &ElemFam[V.i - 1].ElemF;
1049        WITH1 = WITH->M;
1050        if (!strncmp(fname, "l              ", sizeof(partsName)))
1051          x = WITH->PL;
1052        else if (!strncmp(fname, "t              ", sizeof(partsName))) {
1053          if (WITH->PL != 0.0)
1054            x = WITH1->Pirho * WITH->PL * 180.0 / M_PI;
1055          else
1056            x = WITH1->Pirho * 180.0 / M_PI;
1057        } else if (!strncmp(fname, "t1             ", sizeof(partsName)))
1058          x = WITH1->PTx1;
1059        else if (!strncmp(fname, "t2             ", sizeof(partsName)))
1060          x = WITH1->PTx2;
1061        else if (!strncmp(fname, "h1            ", sizeof(partsName)))
1062          x = WITH1->PH1;
1063        else if (!strncmp(fname, "h2            ", sizeof(partsName)))
1064          x = WITH1->PH2;
1065        else if (!strncmp(fname, "gap            ", sizeof(partsName)))
1066          x = WITH1->Pgap;
1067        else if (!strncmp(fname, "roll           ", sizeof(partsName))) {
1068          if (WITH->Pkind == Mpole)
1069            x = WITH1->PdTpar;
1070          else if (WITH->Pkind == Wigl)
1071            x = WITH1->PdTpar;
1072        } else if (!strncmp(fname, "n              ", sizeof(partsName))) {
1073          if (((1 << ((long)WITH->Pkind)) &
1074               ((1 << ((long)Mpole)) | (1 << ((long)Wigl)))) != 0)
1075            x = WITH1->PN;
1076        } else if (!strncmp(fname, "b              ", sizeof(partsName)))
1077          x = GetKparm(1, &V);
1078        else if (!strncmp(fname, "a              ", sizeof(partsName)))
1079          x = GetKparm(2L, &V);
1080        else {
1081          /* error detected */
1082          getest(P_expset(SET1, 0), "  illegal extension...",
1083                 LINK->LINK->LINK);
1084        }
1085        PUSH(x, LINK->LINK->LINK);
1086        GetSym(LINK->LINK->LINK);
1087      } else {
1088        V.i = CheckBLOCKStable(LINK->LINK->LINK->id, LINK->LINK->LINK->LINK);
1089        if (V.i != 0) {
1090          getest(P_addset(P_expset(SET, 0), (long)period_), "<.> expected",
1091                 LINK->LINK->LINK);
1092          getest(P_addset(P_expset(SET2, 0), (long)lsym), "illegal component",
1093                 LINK->LINK->LINK);
1094          x = BlockLength(V.i, LINK->LINK->LINK);
1095          PUSH(x, LINK->LINK->LINK);
1096          GetSym(LINK->LINK->LINK);
1097        } else {  /*4: function ?*/
1098          memcpy(fname, LINK->LINK->LINK->id, sizeof(alfa_));
1099          memset(fname + sizeof(alfa_), ' ',
1100                 sizeof(partsName) - sizeof(alfa_));
1101          GetSym(LINK->LINK->LINK);
1102          switch (*LINK->LINK->LINK->sym) {   /*5*/
1103
1104          case semicolon:
1105            GetSym(LINK->LINK->LINK);
1106            break;
1107
1108          case lparent:  /*6: of lparent*/
1109            GetSym(LINK->LINK->LINK);
1110            Expression(LINK->LINK->LINK);
1111            if (!strncmp(fname, "sin            ", sizeof(partsName)))
1112              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1113                sin(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1114            else if (!strncmp(fname, "cos            ", sizeof(partsName)))
1115              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1116                cos(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1117            else if (!strncmp(fname, "tan            ", sizeof(partsName)))
1118              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1119                tan(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1120            else if (!strncmp(fname, "arcsin         ", sizeof(partsName)))
1121              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1122                ArcSin(LINK->LINK->LINK->S[LINK->LINK->LINK->t],
1123                       LINK->LINK->LINK);
1124            else if (!strncmp(fname, "arccos         ", sizeof(partsName)))
1125              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1126                ArcCos(LINK->LINK->LINK->S[LINK->LINK->LINK->t],
1127                       LINK->LINK->LINK);
1128            else if (!strncmp(fname, "arctan         ", sizeof(partsName)))
1129              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1130                atan(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1131            else if (!strncmp(fname, "sqrt           ", sizeof(partsName)))
1132              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1133                sqrt(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1134            else if (!strncmp(fname, "log            ", sizeof(partsName)))
1135              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1136                log(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1137            else if (!strncmp(fname, "exp            ", sizeof(partsName)))
1138              LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1139                exp(LINK->LINK->LINK->S[LINK->LINK->LINK->t]);
1140            writes(LINK->LINK->LINK);
1141            if (*LINK->LINK->LINK->sym == rparent)
1142              GetSym(LINK->LINK->LINK);
1143            else
1144              longjmp(LINK->LINK->LINK->_JL999, 1);
1145            break;
1146            /*6:of lparent*/
1147          default:
1148            break;
1149          }/*5: of case */
1150        }  /*4: of function?*/
1151      }
1152    }
1153  }  /*1: of ident*/
1154  else if (*LINK->LINK->LINK->sym == realcon) {
1155    PUSH(*LINK->LINK->LINK->rnum, LINK->LINK->LINK);
1156    GetSym(LINK->LINK->LINK);
1157  } else if (*LINK->LINK->LINK->sym == intcon) {
1158    x = *LINK->LINK->LINK->inum;
1159    PUSH(x, LINK->LINK->LINK);
1160    GetSym(LINK->LINK->LINK);
1161  } else if (*LINK->LINK->LINK->sym == lparent) {
1162    GetSym(LINK->LINK->LINK);
1163    Expression(LINK->LINK->LINK);
1164    if (*LINK->LINK->LINK->sym == rparent)
1165      GetSym(LINK->LINK->LINK);
1166    else
1167      longjmp(LINK->LINK->LINK->_JL999, 1);
1168  } else
1169    longjmp(LINK->LINK->LINK->_JL999, 1);
1170
1171  if (*LINK->LINK->LINK->sym != pwrsym)
1172    return;
1173
1174  GetSym(LINK->LINK->LINK);
1175  if (*LINK->LINK->LINK->sym != intcon)
1176    longjmp(LINK->LINK->LINK->_JL999, 1);
1177  LINK->LINK->LINK->S[LINK->LINK->LINK->t] =
1178    pow(LINK->LINK->LINK->S[LINK->LINK->LINK->t],
1179        (double)(*LINK->LINK->LINK->inum));
1180  GetSym(LINK->LINK->LINK);
1181}
1182
1183
1184static void Term(struct LOC_Expression *LINK)
1185{
1186  struct LOC_Term V;
1187  Lat_symbol mulop;
1188
1189  V.LINK = LINK;
1190  /* term */
1191  Factor(&V);
1192  while ((unsigned int)(*LINK->LINK->sym) < 32 &&
1193         ((1 << ((long)(*LINK->LINK->sym))) &
1194          ((1 << ((long)times)) | (1 << ((long)rdiv)))) != 0) {
1195    mulop = *LINK->LINK->sym;
1196    GetSym(LINK->LINK);
1197    Factor(&V);
1198    if (mulop == times) {
1199      LINK->LINK->S[LINK->LINK->t - 1] *= LINK->LINK->S[LINK->LINK->t];
1200      LINK->LINK->t--;
1201      writes(LINK->LINK);
1202    } else {
1203      if (mulop == rdiv) {
1204        LINK->LINK->S[LINK->LINK->t - 1] /= LINK->LINK->S[LINK->LINK->t];
1205        LINK->LINK->t--;
1206        writes(LINK->LINK);
1207      }
1208    }
1209  }
1210}
1211
1212
1213static void Expression(struct LOC_Lat_EVAL *LINK)
1214{
1215  struct LOC_Expression V;
1216  Lat_symbol addop;
1217
1218  V.LINK = LINK;
1219  /* Expression */
1220  if ((unsigned int)(*LINK->sym) < 32 &&
1221      ((1 << ((long)(*LINK->sym))) &
1222       ((1 << ((long)plus_)) | (1 << ((long)minus_)))) != 0) {
1223    addop = *LINK->sym;
1224    GetSym(LINK);
1225    Term(&V);
1226    if (addop == minus_)
1227      LINK->S[LINK->t] = -LINK->S[LINK->t];
1228  } else
1229    Term(&V);
1230
1231  while ((unsigned int)(*LINK->sym) < 32 &&
1232         ((1 << ((long)(*LINK->sym))) &
1233          ((1 << ((long)plus_)) | (1 << ((long)minus_)))) != 0) {
1234    addop = *LINK->sym;
1235    GetSym(LINK);
1236    Term(&V);
1237    if (addop == plus_) {
1238      LINK->S[LINK->t - 1] += LINK->S[LINK->t];
1239      LINK->t--;
1240      writes(LINK);
1241    } else {
1242      if (addop == minus_) {
1243        LINK->S[LINK->t - 1] -= LINK->S[LINK->t];
1244        LINK->t--;
1245        writes(LINK);
1246      }
1247    }
1248  }
1249}
1250
1251/******************************
1252 *                           *
1253 *        E V A L            *
1254 *                           *
1255 ******************************/
1256
1257static double Lat_EVAL(FILE **fi_, FILE **fo_, long *cc_, long *ll_,
1258                       long *errpos_,
1259                       long *lc_, long *nkw_, long *inum_, long emax__,
1260                       long emin__,
1261                       long kmax__, long nmax__, char *chin_, char *id_,
1262                       double *rnum_,
1263                       bool *skipflag_, bool *rsvwd_, char *line_,
1264                       Lat_symbol *sym_,
1265                       alfa_ *key_, Lat_symbol *ksy_, Lat_symbol *sps_,
1266                       struct LOC_Lattice_Read *LINK)
1267{  /* eval */
1268  struct LOC_Lat_EVAL V;
1269  double Result = 0.0;
1270  symset SET;
1271
1272  V.LINK = LINK;
1273  V.fi = fi_;
1274  V.fo = fo_;
1275  V.cc = cc_;
1276  V.ll = ll_;
1277  V.errpos = errpos_;
1278  V.lc = lc_;
1279  V.nkw = nkw_;
1280  V.inum = inum_;
1281  V.emax_ = emax__;
1282  V.emin_ = emin__;
1283  V.kmax_ = kmax__;
1284  V.nmax_ = nmax__;
1285  V.chin = chin_;
1286  V.id = id_;
1287  V.rnum = rnum_;
1288  V.skipflag = skipflag_;
1289  V.rsvwd = rsvwd_;
1290  V.line = line_;
1291  V.sym = sym_;
1292  V.key = key_;
1293  V.ksy = ksy_;
1294  V.sps = sps_;
1295  if (setjmp(V._JL999))
1296    goto _L999;
1297  P_addset(P_expset(V.facbegsys, 0), (long)intcon);
1298  P_addset(V.facbegsys, (long)realcon);
1299  P_addset(V.facbegsys, (long)ident);
1300  P_addset(V.facbegsys, (long)lparent);
1301  GetSym(&V);
1302  V.t = 0;
1303  Expression(&V);
1304  if (V.t != 1)
1305    goto _L999;
1306  Result = V.S[1];
1307  goto _L888;
1308
1309 _L999:
1310  ErrFlag = true;
1311  test(P_expset(SET, 0), "** Lat_Eval: error",
1312       &V);
1313 _L888:   /* exit */
1314
1315  return Result;
1316}
1317
1318
1319/* Local variables for Lat_ProcessBlockInput: */
1320struct LOC_Lat_ProcessBlockInput
1321{
1322  struct LOC_Lattice_Read *LINK;
1323  FILE **fi, **fo;
1324  long *cc, *ll, *errpos, *lc, *nkw, *inum, emax_, emin_, kmax_, nmax_;
1325  char *chin;
1326  char *id;
1327  double *rnum;
1328  bool *skipflag, *rsvwd;
1329  char *line;
1330  Lat_symbol *sym;
1331  alfa_ *key;
1332  Lat_symbol *ksy;
1333  Lat_symbol *sps;
1334};
1335
1336static void GetBlock(struct LOC_Lat_ProcessBlockInput *LINK);
1337
1338
1339static void errorm_(const char *cmnt, struct LOC_Lat_ProcessBlockInput *LINK)
1340{
1341  Lat_errorm(cmnt, LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1342             LINK->lc, LINK->chin, LINK->skipflag, LINK->line, LINK->LINK);
1343}
1344
1345
1346static void GetSym_(struct LOC_Lat_ProcessBlockInput *LINK)
1347{
1348  Lat_GetSym(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos, LINK->lc,
1349             LINK->nkw, LINK->inum, LINK->emax_, LINK->emin_, LINK->kmax_,
1350             LINK->nmax_, LINK->chin, LINK->id, LINK->rnum, LINK->skipflag,
1351             LINK->rsvwd, LINK->line, LINK->sym, LINK->key, LINK->ksy,
1352             LINK->sps, LINK->LINK);
1353}
1354
1355
1356static void test_(long *s1, const char *cmnt, struct LOC_Lat_ProcessBlockInput *LINK)
1357{
1358  /*test*/
1359  if (!P_inset(*LINK->sym, s1))
1360    errorm_(cmnt, LINK);
1361}
1362
1363
1364static void getest_(long *s1, const char *cmnt,
1365                    struct LOC_Lat_ProcessBlockInput *LINK)
1366{
1367  /*test*/
1368  GetSym_(LINK);
1369  if (!P_inset(*LINK->sym, s1))
1370    errorm_(cmnt, LINK);
1371}
1372
1373
1374double EVAL(struct LOC_Lat_ProcessBlockInput *LINK)
1375{
1376  return (Lat_EVAL(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1377                   LINK->lc, LINK->nkw, LINK->inum, LINK->emax_, LINK->emin_,
1378                   LINK->kmax_, LINK->nmax_, LINK->chin, LINK->id, LINK->rnum,
1379                   LINK->skipflag, LINK->rsvwd, LINK->line, LINK->sym,
1380                   LINK->key, LINK->ksy, LINK->sps, LINK->LINK));
1381}
1382
1383
1384static void DeBlock(long ii, long k4, struct LOC_Lat_ProcessBlockInput *LINK)
1385{
1386  long  k1, k2, k3, k5;
1387
1388  k2 = LINK->LINK->BlockS[ii - 1].BSTART;
1389  k3 = LINK->LINK->BlockS[ii - 1].BOWARI;
1390  for (k5 = 1; k5 <= k4; k5++) {
1391    for (k1 = k2 - 1; k1 < k3; k1++) {  /*11*/
1392      LINK->LINK->Bpointer++;
1393      if (LINK->LINK->Bpointer >= NoBEmax) {
1394        printf("** DeBlock: NoBEmax exceeded %ld (%d)\n",
1395               LINK->LINK->Bpointer, NoBEmax);
1396        exit(1);
1397      }
1398      LINK->LINK->Bstack[LINK->LINK->Bpointer - 1] = LINK->LINK->Bstack[k1];
1399    }  /*11*/
1400  }
1401  GetSym_(LINK);
1402  if (*LINK->sym == comma)
1403    GetSym_(LINK);
1404}
1405
1406/* Local variables for GetBlock: */
1407struct LOC_GetBlock
1408{
1409  struct LOC_Lat_ProcessBlockInput *LINK;
1410};
1411
1412
1413static void InsideParent(long k4, struct LOC_GetBlock *LINK)
1414{
1415  long    b, b1, b2, k1;
1416  symset  SET;
1417
1418  b1 = LINK->LINK->LINK->Bpointer + 1;
1419  GetSym_(LINK->LINK);
1420  GetBlock(LINK->LINK);
1421  b2 = LINK->LINK->LINK->Bpointer;
1422  if (k4 >= 2) {
1423    for (k1 = 2; k1 <= k4; k1++) {
1424      for (b = b1 - 1; b < b2; b++) {
1425        LINK->LINK->LINK->Bpointer++;
1426        if (LINK->LINK->LINK->Bpointer >= NoBEmax) {
1427          printf("** InsideParent: NoBEmax exceeded %ld (%d)\n",
1428                 LINK->LINK->LINK->Bpointer, NoBEmax);
1429          exit(1);
1430        }
1431        LINK->LINK->LINK->Bstack[LINK->LINK->LINK->Bpointer - 1] = LINK->
1432          LINK->LINK->Bstack[b];
1433      }
1434    }
1435  }
1436  test_(P_expset(SET, 1 << ((long)rparent)), "<)> expected",
1437        LINK->LINK);
1438  getest_(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon)) |
1439                   (1 << ((long)rparent))), "<, > or <;> expected",
1440          LINK->LINK);
1441  if (*LINK->LINK->sym == comma)
1442    GetSym_(LINK->LINK);
1443}
1444
1445
1446static void Doinverse(struct LOC_GetBlock *LINK)
1447{
1448  long    b, b1, b2, b3, k1, k4;
1449  symset  SET;
1450  long    FORLIM;
1451
1452  getest_(P_expset(SET, 1 << ((long)lparent)), "<(> expected after INV",
1453          LINK->LINK);
1454  b1 = LINK->LINK->LINK->Bpointer + 1;
1455  GetSym_(LINK->LINK);
1456  GetBlock(LINK->LINK);
1457  b2 = LINK->LINK->LINK->Bpointer;
1458  /* Bug fix: INV(A, B, ...) for 2 elements
1459  k4 = b2 - b1 */
1460  k4 = b2 - b1 + 1;
1461  if (k4 >= 2) {
1462    k4 /= 2; b3 = b1 + k4; k1 = 0;
1463    FORLIM = b3;
1464  /* Bug fix: INV(A, B, ...) for 2 elements
1465    for (b = b1 - 1; b < FORLIM; b++) { */
1466    for (b = b1 - 1; b < FORLIM-1; b++) {
1467      b3 = LINK->LINK->LINK->Bstack[b];
1468      LINK->LINK->LINK->Bstack[b] = LINK->LINK->LINK->Bstack[b2-k1-1];
1469      LINK->LINK->LINK->Bstack[b2-k1-1] = b3;
1470      k1++;
1471    }
1472  }
1473  test_(P_expset(SET, 1 << ((long)rparent)), "<)> expected", LINK->LINK);
1474  getest_(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon)) |
1475                   (1 << ((long)rparent))), "<, > or <;> expected",
1476          LINK->LINK);
1477  if (*LINK->LINK->sym == comma) GetSym_(LINK->LINK);
1478}
1479
1480
1481static void GetBlock(struct LOC_Lat_ProcessBlockInput *LINK)
1482{
1483  struct  LOC_GetBlock V;
1484  long    i, ii, k1, k4 = 0;
1485  long    SET[(long)invsym / 32 + 2];
1486  symset  SET1;
1487
1488  V.LINK = LINK;
1489  do {   /*7*/
1490    P_addset(P_expset(SET, 0), (long)ident);
1491    P_addset(SET, (long)intcon);
1492    P_addset(SET, (long)lparent);
1493    test_(P_addset(SET, (long)invsym),
1494          "<Element/Block name>, <integer>, <INV> or <(> expected",
1495          LINK);
1496    if (*LINK->sym == lparent)   /*7*/
1497      InsideParent(1, &V);
1498    else {
1499      if (*LINK->sym == invsym)
1500        Doinverse(&V);
1501      else {
1502        if (*LINK->sym == ident) {  /*8*/
1503          i = CheckElementtable(LINK->id, LINK->LINK);
1504          if (i != 0) {  /*9*/
1505            LINK->LINK->Bpointer++;
1506            if (LINK->LINK->Bpointer >= NoBEmax) {
1507              printf("** GetBlock: NoBEmax exceeded %ld (%d)\n",
1508                     LINK->LINK->Bpointer, NoBEmax);
1509              exit(1);
1510            }
1511            LINK->LINK->Bstack[LINK->LINK->Bpointer - 1] = i;
1512            GetSym_(LINK);
1513            if (*LINK->sym == comma)
1514              GetSym_(LINK);
1515          } else {  /*9*/
1516            ii = CheckBLOCKStable(LINK->id, LINK->LINK);
1517            if (ii != 0) {  /*10*/
1518              DeBlock(ii, 1, LINK);
1519            } else {  /*10*/
1520              ii = CheckUDItable(LINK->id, LINK->LINK);
1521              if (ii != 0) {  /*11*/
1522                k4 = (long)floor(LINK->LINK->UDItable[ii - 1].Uvalue + 0.5);
1523                GetSym_(LINK);
1524              } else
1525                test_(P_expset(SET1, 0), "invalid identifier",
1526                      LINK);
1527              /*11*/
1528              test_(P_expset(SET1, 1 << ((long)times)), "<*> expected",
1529                    LINK);
1530              if (*LINK->sym == times) {  /*11*/
1531                P_addset(P_expset(SET, 0), (long)ident);
1532                P_addset(SET, (long)lparent);
1533                getest_(P_addset(SET, (long)invsym),
1534                        "<element/Block name>, <INV> or <(> expected",
1535                        LINK);
1536                if (*LINK->sym == lparent)
1537                  InsideParent(k4, &V);
1538                else {
1539                  if (*LINK->sym == invsym)
1540                    Doinverse(&V);
1541                  else {
1542                    if (*LINK->sym == ident) {  /*12*/
1543                      i = CheckElementtable(LINK->id, LINK->LINK);
1544                      if (i != 0) {  /*13*/
1545                        for (k1 = 1; k1 <= k4; k1++) {  /*14*/
1546                          LINK->LINK->Bpointer++;
1547                          if (LINK->LINK->Bpointer >= NoBEmax) {
1548                            printf("** GetBlock: NoBEmax exceeded %ld (%d)\n",
1549                                   LINK->LINK->Bpointer, NoBEmax);
1550                            exit(1);
1551                          }
1552                          LINK->LINK->Bstack[LINK->LINK->Bpointer - 1] = i;
1553                        }  /*14*/
1554                        GetSym_(LINK);
1555                        if (*LINK->sym == comma)
1556                          GetSym_(LINK);
1557                      } else {  /*13*/
1558                        ii = CheckBLOCKStable(LINK->id, LINK->LINK);
1559                        if (ii == 0)
1560                          test_(P_expset(SET1, 0), "invalid name",
1561                                LINK);
1562                        DeBlock(ii, k4, LINK);
1563                      }  /*13*/
1564                    }  /*12*/
1565                  }
1566                }
1567              }  /*11*/
1568            }  /*10*/
1569          }  /*9*/
1570        } else {
1571          if (*LINK->sym == intcon) {  /*8*/
1572            k4 = *LINK->inum;
1573            GetSym_(LINK);
1574            test_(P_expset(SET1, 1 << ((long)times)), "<*> expected",
1575                  LINK);
1576            if (*LINK->sym == times) {  /*9*/
1577              GetSym_(LINK);
1578              P_addset(P_expset(SET, 0), (long)ident);
1579              P_addset(SET, (long)lparent);
1580              test_(P_addset(SET, (long)invsym),
1581                    "<element/Block name>, <INV> or <(> expected",
1582                    LINK);
1583              if (*LINK->sym == lparent)
1584                InsideParent(k4, &V);
1585              else {
1586                if (*LINK->sym == invsym)
1587                  Doinverse(&V);
1588                else {
1589                  if (*LINK->sym == ident) {  /*10*/
1590                    i = CheckElementtable(LINK->id, LINK->LINK);
1591                    if (i != 0) {  /*11*/
1592                      for (k1 = 1; k1 <= k4; k1++) {  /*12*/
1593                        LINK->LINK->Bpointer++;
1594                        if (LINK->LINK->Bpointer >= NoBEmax) {
1595                          printf("** GetBlock: NoBEmax exceeded %ld (%d)\n",
1596                                 LINK->LINK->Bpointer, NoBEmax);
1597                          exit(1);
1598                        }
1599                        LINK->LINK->Bstack[LINK->LINK->Bpointer - 1] = i;
1600                      }  /*12*/
1601                      GetSym_(LINK);
1602                      if (*LINK->sym == comma)
1603                        GetSym_(LINK);
1604                    } else {  /*11*/
1605                      ii = CheckBLOCKStable(LINK->id, LINK->LINK);
1606                      if (ii == 0)
1607                        test_(P_expset(SET1, 0), "invalid name",
1608                              LINK);
1609                      DeBlock(ii, k4, LINK);
1610                    }  /*11*/
1611                  }  /*10*/
1612                }
1613              }
1614            }  /*9*/
1615          } else {
1616            if (*LINK->sym == minus_) {  /*8*/
1617              GetSym_(LINK);
1618              i = CheckElementtable(LINK->id, LINK->LINK);
1619              if (i != 0) {  /*9*/
1620                LINK->LINK->Bpointer++;
1621                if (LINK->LINK->Bpointer >= NoBEmax) {
1622                  printf("** GetBlock: NoBEmax exceeded %ld (%d)\n",
1623                         LINK->LINK->Bpointer, NoBEmax);
1624                  exit(1);
1625                }
1626                LINK->LINK->Bstack[LINK->LINK->Bpointer - 1] = -i;
1627                GetSym_(LINK);
1628                if (*LINK->sym == comma)
1629                  GetSym_(LINK);
1630              } else
1631                test_(P_expset(SET1, 0), "<element name> expected.",
1632                      LINK);
1633            }  /*8*/
1634          }
1635        }
1636      }
1637    }
1638  } while (*LINK->sym == (long)invsym || *LINK->sym == (long)minus_ ||
1639           *LINK->sym == (long)intcon || *LINK->sym == (long)ident);
1640}
1641
1642
1643static void Lat_ProcessBlockInput(FILE **fi_, FILE **fo_, long *cc_, long *ll_,
1644                                  long *errpos_, long *lc_, long *nkw_,
1645                                  long *inum_, long emax__, long emin__,
1646                                  long kmax__, long nmax__, char *chin_,
1647                                  char *id_, char *BlockName,
1648                                  double *rnum_, bool *skipflag_, bool *rsvwd_,
1649                                  char *line_,
1650                                  Lat_symbol *sym_, alfa_ *key_,
1651                                  Lat_symbol *ksy_, Lat_symbol *sps_,
1652                                  struct LOC_Lattice_Read *LINK)
1653{
1654  struct LOC_Lat_ProcessBlockInput V;
1655  long i;
1656  symset SET;
1657  _REC_BlockStype *WITH;
1658
1659  V.LINK = LINK;
1660  V.fi = fi_;
1661  V.fo = fo_;
1662  V.cc = cc_;
1663  V.ll = ll_;
1664  V.errpos = errpos_;
1665  V.lc = lc_;
1666  V.nkw = nkw_;
1667  V.inum = inum_;
1668  V.emax_ = emax__;
1669  V.emin_ = emin__;
1670  V.kmax_ = kmax__;
1671  V.nmax_ = nmax__;
1672  V.chin = chin_;
1673  V.id = id_;
1674  V.rnum = rnum_;
1675  V.skipflag = skipflag_;
1676  V.rsvwd = rsvwd_;
1677  V.line = line_;
1678  V.sym = sym_;
1679  V.key = key_;
1680  V.ksy = ksy_;
1681  V.sps = sps_;
1682  i = CheckElementtable(BlockName, LINK);
1683  if (i != 0) {
1684    test_(P_expset(SET, 0), "<Block name>: conflict with Element name", &V);
1685    return;
1686  }
1687  /* Increment number of defined blocks */
1688  LINK->NoB++;
1689  if (LINK->NoB > NoBmax) {
1690    printf("** NoBmax exhausted: %ld(%d)\n", LINK->NoB, NoBmax);
1691    return;
1692  }
1693  WITH = &LINK->BlockS[LINK->NoB - 1];
1694  memcpy(WITH->Bname, BlockName, sizeof(partsName));
1695  WITH->BSTART = LINK->Bpointer + 1;
1696  GetBlock(&V);
1697  test_(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
1698  GetSym_(&V);
1699  WITH->BOWARI = LINK->Bpointer;
1700}  /* ProcessBlockInput */
1701
1702
1703static bool Lat_CheckWiggler(FILE **fo, long i, struct LOC_Lattice_Read *LINK)
1704{
1705  bool         Result;
1706  double       a, Lambda, L, diff;
1707  long         NN;
1708  ElemFamType  *WITH;
1709  elemtype     *WITH1;
1710  WigglerType  *WITH2;
1711
1712  Result = false;
1713  WITH = &ElemFam[i-1]; WITH1 = &WITH->ElemF; WITH2 = WITH1->W;
1714  Lambda = WITH2->lambda;
1715  L = WITH1->PL; a = L/Lambda;
1716  NN = (long)floor(a+0.01+0.5);
1717  diff = fabs((L-NN*Lambda)/L);
1718  if (diff < 1e-5) return true;
1719  printf("\n");
1720  printf(">>> Incorrect definition of %.*s\n\n", NameLength, WITH1->PName);
1721  printf("    L      ( total length ) =%20.12f [m]\n", L);
1722  printf("    Lambda ( wave  length ) =%20.12f [m]\n", Lambda);
1723  printf("    # of Period = L/Lambda  =%20.12f ?????\n\n", L / Lambda);
1724  return true;
1725}
1726
1727/* Local variables for Lat_DealElement: */
1728struct LOC_Lat_DealElement
1729{
1730  struct      LOC_Lattice_Read *LINK;
1731  FILE        **fi, **fo;
1732  long        *cc, *ll, *errpos, *lc, *nkw, *inum, emax_, emin_, kmax_, nmax_;
1733  char        *chin;
1734  char        *id;
1735  char        *BlockName;
1736  double      *rnum;
1737  bool        *skipflag, *rsvwd;
1738  char        *line;
1739  Lat_symbol  *sym;
1740  alfa_       *key;
1741  Lat_symbol  *ksy;
1742  Lat_symbol  *sps;
1743  jmp_buf     _JL9999;
1744  double      B[HOMmax+HOMmax+1];
1745  bool        BA[HOMmax+HOMmax+1];
1746  int         n_harm, harm[n_harm_max];
1747  double      kxV[n_harm_max], BoBrhoV[n_harm_max];
1748  double      kxH[n_harm_max], BoBrhoH[n_harm_max], phi[n_harm_max];
1749  long        DBNsavemax;
1750  DBNameType  DBNsave[nKidMax];
1751};
1752
1753
1754static void errorm__(const char *cmnt, struct LOC_Lat_DealElement *LINK)
1755{
1756  Lat_errorm(cmnt, LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1757             LINK->lc, LINK->chin, LINK->skipflag, LINK->line, LINK->LINK);
1758}
1759
1760
1761static void GetSym__(struct LOC_Lat_DealElement *LINK)
1762{
1763  Lat_GetSym(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos, LINK->lc,
1764             LINK->nkw, LINK->inum, LINK->emax_, LINK->emin_, LINK->kmax_,
1765             LINK->nmax_, LINK->chin, LINK->id, LINK->rnum, LINK->skipflag,
1766             LINK->rsvwd, LINK->line, LINK->sym, LINK->key, LINK->ksy,
1767             LINK->sps, LINK->LINK);
1768}
1769
1770static void test__(long *s1, const char *cmnt, struct LOC_Lat_DealElement *LINK)
1771{
1772  /*test*/
1773  if (!P_inset(*LINK->sym, s1))
1774    errorm__(cmnt, LINK);
1775}
1776
1777
1778static void getest__(long *s1, const char *cmnt, struct LOC_Lat_DealElement *LINK)
1779{
1780  /*test*/
1781  GetSym__(LINK);
1782  if (!P_inset(*LINK->sym, s1))
1783    errorm__(cmnt, LINK);
1784}
1785
1786
1787static double EVAL_(struct LOC_Lat_DealElement *LINK)
1788{
1789  return (Lat_EVAL(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1790                   LINK->lc, LINK->nkw, LINK->inum, LINK->emax_, LINK->emin_,
1791                   LINK->kmax_, LINK->nmax_, LINK->chin, LINK->id, LINK->rnum,
1792                   LINK->skipflag, LINK->rsvwd, LINK->line, LINK->sym,
1793                   LINK->key, LINK->ksy, LINK->sps, LINK->LINK));
1794}
1795
1796static void ProcessBlockInput(struct LOC_Lat_DealElement *LINK)
1797{
1798  Lat_ProcessBlockInput(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1799                        LINK->lc, LINK->nkw, LINK->inum, LINK->emax_,
1800                        LINK->emin_, LINK->kmax_, LINK->nmax_, LINK->chin,
1801                        LINK->id, LINK->BlockName, LINK->rnum, LINK->skipflag,
1802                        LINK->rsvwd, LINK->line, LINK->sym, LINK->key,
1803                        LINK->ksy, LINK->sps, LINK->LINK);
1804}  /* ProcessBlockInput */
1805
1806
1807static void CheckWiggler(long i, struct LOC_Lat_DealElement *LINK)
1808{
1809  if (!Lat_CheckWiggler(LINK->fo, i, LINK->LINK))
1810    longjmp(LINK->_JL9999, 1);
1811}
1812
1813static void GetHOM(struct LOC_Lat_DealElement *LINK)
1814{
1815  long    i;
1816  double  x, y;
1817  symset  SET;
1818
1819  getest__(P_expset(SET, 1 << ((long)lparent)), "<(> expected", LINK);
1820  do {
1821    i = (long)floor(EVAL_(LINK) + 0.5);
1822    if (i < 1 || HOMmax < i)
1823      getest__(P_expset(SET, 0), "invalid value detected", LINK);
1824    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1825    x = EVAL_(LINK);
1826    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1827    y = EVAL_(LINK);
1828    LINK->B[i+HOMmax] = x; LINK->B[HOMmax-i] = y;
1829    LINK->BA[i+HOMmax] = true; LINK->BA[HOMmax-i] = true;
1830    test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)rparent))),
1831           "<, > or <)> expected", LINK);
1832  } while (*LINK->sym != rparent);
1833  GetSym__(LINK);
1834}
1835
1836
1837static void ClearHOMandDBN(struct LOC_Lat_DealElement *LINK)
1838{
1839  long i;
1840
1841  for (i = -HOMmax; i <= HOMmax; i++) {
1842    LINK->B[i + HOMmax] = 0.0;
1843    LINK->BA[i + HOMmax] = false;
1844  }
1845  LINK->DBNsavemax = 0;
1846}
1847
1848
1849static void AssignHOM(long elem, struct LOC_Lat_DealElement *LINK)
1850{
1851  long       i;
1852  MpoleType  *M;
1853
1854  M = ElemFam[elem-1].ElemF.M;
1855  for (i = -HOMmax; i <= HOMmax; i++) {
1856    if (LINK->BA[i+HOMmax]) {
1857      M->PBpar[i+HOMmax] = LINK->B[i+HOMmax];
1858      M->Porder = max(abs(i), M->Porder);
1859    }
1860  }
1861}
1862
1863/*********************
1864 get the high order field
1865**********************/
1866static void GetHarm(struct LOC_Lat_DealElement *LINK)
1867{
1868  long    i, n;
1869  symset  SET;
1870
1871  getest__(P_expset(SET, 1 << ((long)lparent)), "<(> expected", LINK);
1872  LINK->n_harm = 0;
1873  do {
1874    LINK->n_harm++; n = LINK->n_harm;
1875    i = (long)floor(EVAL_(LINK)+0.5);
1876    if (i < 1 || n_harm_max < LINK->n_harm+1)
1877      getest__(P_expset(SET, 0), "invalid value detected", LINK);
1878    LINK->harm[n-1] = i;
1879    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1880    LINK->kxV[n-1] = EVAL_(LINK);
1881    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1882    LINK->BoBrhoV[n-1] = EVAL_(LINK);
1883    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1884    LINK->kxH[n-1] = EVAL_(LINK);
1885    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1886    LINK->BoBrhoH[n-1] = EVAL_(LINK);
1887    test__(P_expset(SET, 1 << ((long)comma)), "<, > expected", LINK);
1888    LINK->phi[n-1] = EVAL_(LINK);
1889    test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)rparent))),
1890           "<, > or <)> expected", LINK);
1891  } while (*LINK->sym != rparent);
1892  GetSym__(LINK);
1893}
1894
1895
1896static void AssignHarm(long elem, struct LOC_Lat_DealElement *LINK)
1897{
1898  long         i;
1899  WigglerType  *W;
1900
1901  W = ElemFam[elem-1].ElemF.W; W->n_harm += LINK->n_harm;
1902  // the fundamental is stored in harm[0], etc.
1903  for (i = 1; i < W->n_harm; i++) {
1904    W->harm[i] = LINK->harm[i-1];
1905    W->kxV[i] = LINK->kxV[i-1]; W->BoBrhoV[i] = LINK->BoBrhoV[i-1];
1906    W->kxH[i] = LINK->kxH[i-1]; W->BoBrhoH[i] = LINK->BoBrhoH[i-1];
1907    W->phi[i] = LINK->phi[i-1];
1908  }
1909}
1910
1911
1912static void GetDBN_(struct LOC_Lat_DealElement *LINK)
1913
1914{
1915  long i;
1916  symset SET;
1917  long SET1[(long)squote / 32 + 2];
1918
1919  getest__(P_expset(SET, 1 << ((long)lparent)), "<(> expected:GetDBN", LINK);
1920  do {
1921    getest__(P_addset(P_expset(SET1, 0), (long)squote),
1922             "<'> expected:GetDBN", LINK);
1923    LINK->DBNsavemax++;
1924    for (i = 0; i < DBNameLen; i++)
1925      LINK->DBNsave[LINK->DBNsavemax - 1][i] = ' ';
1926    i = 0;
1927    while (*LINK->chin != '\'' && i < DBNameLen) {
1928      i++;
1929      LINK->DBNsave[LINK->DBNsavemax - 1][i - 1] = *LINK->chin;
1930      Lat_Nextch(LINK->fi, LINK->fo, LINK->cc, LINK->ll, LINK->errpos,
1931                 LINK->lc, LINK->chin, LINK->skipflag, LINK->line,
1932                 LINK->LINK);
1933    }
1934    getest__(P_addset(P_expset(SET1, 0), (long)squote),
1935             "<'> expected:GetDBN", LINK);
1936    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)rparent))),
1937             "<, > or <)> expected:GetDBN", LINK);
1938  }
1939  while (*LINK->sym != rparent);
1940  GetSym__(LINK);
1941}
1942
1943
1944static void adjdbname(char *DBname1, char *DBname2)
1945{
1946  long i, j, k, offset;
1947  bool first, blank;
1948
1949  blank = true;
1950  for (j = 0; j < DBNameLen; j++) {
1951    if (DBname1[j] != ' ')
1952      blank = false;
1953  }
1954  first = true;
1955  j = 0;
1956  offset = 0;
1957  if (blank)
1958    return;
1959  do {
1960    j++;
1961    DBname2[j + offset - 1] = DBname1[j - 1];
1962    if (first && DBname1[j - 1] == ' ') {
1963      first = false;
1964      k = -1;
1965      do {
1966        k++;
1967      } while (DBname1[j+k] == ' ' && j+k+1 != DBNameLen);
1968      for (i = j+k; i <= 7; i++)
1969        DBname2[i] = ' ';
1970      offset = 8 - j;
1971    }
1972  }
1973  while (j < DBNameLen-offset);
1974}
1975
1976
1977static void SetDBN(struct LOC_Lat_DealElement *LINK)
1978{
1979  long         i;
1980  ElemFamType  *WITH;
1981  long         FORLIM;
1982
1983  if (globval.Elem_nFam > Elem_nFamMax) {
1984    printf("Elem_nFamMax exceeded: %ld(%ld)\n",
1985           globval.Elem_nFam, (long)Elem_nFamMax);
1986    exit_(1);
1987  }
1988  WITH = &ElemFam[globval.Elem_nFam-1]; WITH->NoDBN = LINK->DBNsavemax;
1989  if (WITH->NoDBN > 0) {
1990    FORLIM = WITH->NoDBN;
1991    for (i = 0; i < FORLIM; i++)
1992      adjdbname(LINK->DBNsave[i], WITH->DBNlist[i]);
1993  }
1994}
1995
1996/**************************************************************************
1997 static bool Lat_DealElement(FILE **fi_, FILE **fo_, long *cc_, long *ll_,
1998                          long *errpos_, long *lc_, long *nkw_, long *inum_,
1999                          long emax__, long emin__,
2000                          long kmax__, long nmax__, char *chin_, char *id_,
2001                          char *ElementName,
2002                          char *BlockName_, double *rnum_, bool *skipflag_,
2003                          bool *rsvwd_,
2004                          char *line_, Lat_symbol *sym_, alfa_ *key_,
2005                          Lat_symbol *ksy_,
2006                          Lat_symbol *sps_, struct LOC_Lattice_Read *LINK)
2007
2008   Purpose:
2009             Read the lattice from file fi_,
2010              first, read the element parameters,
2011              then, read the lattice
2012              element type: drift, quadrupole,sextupole,bending,cavity,.....
2013
2014    *************************************************************************/
2015static bool Lat_DealElement(FILE **fi_, FILE **fo_, long *cc_, long *ll_,
2016                            long *errpos_, long *lc_, long *nkw_, long *inum_,
2017                            long emax__, long emin__,
2018                            long kmax__, long nmax__, char *chin_, char *id_,
2019                            char *ElementName,
2020                            char *BlockName_, double *rnum_, bool *skipflag_,
2021                            bool *rsvwd_,
2022                            char *line_, Lat_symbol *sym_, alfa_ *key_,
2023                            Lat_symbol *ksy_,
2024                            Lat_symbol *sps_, struct LOC_Lattice_Read *LINK)
2025{
2026  struct LOC_Lat_DealElement V;
2027  bool           Result = false;
2028  double         t=0.0, t1=0.0, t2=0.0, h1=0,h2=0,gap=0.0, QL = 0.0, QK=0.0;
2029  double         QKick=0.0;  /* kick angle of the corrector [rad]*/
2030  int            Kplane=0; /* kick plane of the corrector, 1 for H plane, -1 for V plane*/
2031  double         QKV=0.0, QKH=0.0, QKxV=0.0, QKxH=0.0, QPhi=0.0, QKS=0.0;
2032  double         dt=0.0, Frf=0.0, Vrf=0.0;
2033  long            harnum=0L;
2034  int            k1=1; //number of cut slice of the element
2035  int            k2=4; //integration method; Meth_Linear=0, Meth_First=1,Meth_Second=2,Meth_Fourth=4
2036  int            edge_effect1=0,edge_effect2=0; //flag to turn on/off dipole fringe field
2037  int            FF1=0, FF2=0;
2038  double         FFscaling=0.0;
2039  Lat_symbol     sym1;
2040  symset         mysys, SET;
2041  long           SET1[(long)lsym / 32 + 2];
2042  ElemFamType    *WITH;
2043  elemtype       *WITH1;
2044  MpoleType      *WITH2;
2045  symset         SET2;
2046  CavityType     *WITH3;
2047  long           SET3[(long)possym / 32 + 2];
2048  long           SET4[(long)dbnsym / 32 + 2];
2049  WigglerType    *WITH4;
2050  FieldMapType   *WITH6;
2051  InsertionType  *WITH5;   /* ID Laurent */
2052  SolenoidType   *WITH7;
2053  char str1[100] = "";
2054  char str2[100] = "";
2055  bool firstflag  = false; // flag for first kick input
2056  bool secondflag = false; // flag for second kick input
2057  long           i;
2058  double         scaling1, scaling2;
2059
2060  V.LINK = LINK;
2061  V.fi = fi_; V.fo = fo_; V.cc = cc_; V.ll = ll_; V.errpos = errpos_;
2062  V.lc = lc_; V.nkw = nkw_; V.inum = inum_; V.emax_ = emax__; V.emin_ = emin__;
2063  V.kmax_ = kmax__; V.nmax_ = nmax__; V.chin = chin_; V.id = id_;
2064  V.BlockName = BlockName_; V.rnum = rnum_; V.skipflag = skipflag_;
2065  V.rsvwd = rsvwd_; V.line = line_; V.sym = sym_; V.key = key_; V.ksy = ksy_;
2066  V.sps = sps_;
2067  if (setjmp(V._JL9999)) goto _L9999;
2068  Result = false;
2069
2070  switch (*V.sym) {
2071   
2072    /**************************************************************************
2073       Drift
2074    **************************************************************************
2075
2076    <name>: Drift,
2077            L=<length>; [m]
2078
2079    Example
2080
2081      L1: Drift, L=0.30;
2082
2083    *************************************************************************/
2084  case drfsym:
2085    getest__(P_expset(SET, 1 << ((long)comma)), "<comma> expected", &V);
2086    getest__(P_addset(P_expset(SET1, 0), (long)lsym), "<L> expected", &V);
2087    getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2088    *V.rnum = EVAL_(&V);
2089    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
2090    GetSym__(&V);
2091    QL = *V.rnum; 
2092    globval.Elem_nFam++;
2093    if (globval.Elem_nFam <= Elem_nFamMax) {
2094      WITH = &ElemFam[globval.Elem_nFam-1];
2095      WITH1 = &WITH->ElemF;
2096      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2097   //   WITH1->PL = *V.rnum;
2098       WITH1->PL = QL;
2099      WITH1->Pkind = PartsKind(drift);
2100      Drift_Alloc(&WITH->ElemF);
2101    } else {
2102      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2103             globval.Elem_nFam, (long)Elem_nFamMax);
2104      exit_(1);
2105    }
2106    break;
2107
2108    /**************************************************************************
2109      bending
2110    **************************************************************************
2111
2112    <name>: Bending,
2113            L      = <length>, ( [m] )
2114            T      = <bending angle>, ( [degree] )
2115            T1     = <entrance angle>, ( [degree] )
2116            T2     = <exit angle>, ( [degree] )
2117            gap    = <total magnet gap>, ( [m] )
2118   edge_effect1    = 1/0, turn on/ff the entrance edge effect,
2119                     and fringe field (if gap != 0)
2120   edge_effect2    = 1/0, turn on/ff the exit edge effect,
2121                     and fringe field (if gap != 0)
2122            K      = <K-value>, ( [m^-2] )
2123                     ( K > 0 : focusing in horizontal plane )
2124                     ( K < 0 : defocusing in horizontal plane )
2125            N      = <# of kicks>,
2126            method = <method>, ( 2 or 4. The method to divide Q into slices.)
2127                           ( The detail of <method> will be discussed later.)
2128            Default value is 2.
2129            Roll   = <roll angle>, ( [deg], design roll angle )
2130            HOM    = (i, <Bi>, <Ai>, ( multipole compoments (power series) )
2131                      j, <Bj>, <Aj>, ( Systematic error Only )
2132                      ............   ( Random errors are assigned )
2133                     n, <Bn>, <An>); ( in a Program File using procedures )
2134
2135    Example
2136
2137      B: bending, L=0.70, T=10.0, T1:=5.0, T2:=5.0, H1=0, H2=0, gap=0.03, edge_effect1=1, edge_effect2=1, K=-1.0, N=8, Method=2;
2138
2139    *************************************************************************/
2140  case bndsym:  /*4*/
2141    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2142    GetSym__(&V);
2143    QL = 0.0;   /* L */
2144    QK = 0.0;   /* K, quadrupole components*/
2145    k1 = 1;   /* N */
2146    t  = 0.0;   /* T */
2147    t1 = 0.0;   /* T1 */
2148    t2 = 0.0;   /* T2 */
2149    h1 = 0.0;
2150    h2 = 0.0;
2151    gap = 0.0;   /* gap */
2152    edge_effect1 = 0; /* edge_effect effect at the entrance */ 
2153    edge_effect2 = 0; /* edge effect at the exit */ 
2154    k2 = Meth_Fourth;   /* method */
2155    dt = 0.0;
2156    ClearHOMandDBN(&V);
2157    P_addset(P_expset(mysys, 0), (long)lsym);
2158    P_addset(mysys, (long)ksym);
2159    P_addset(mysys, (long)nsym);
2160    P_addset(mysys, (long)mthsym);
2161    P_addset(mysys, (long)tsym);
2162    P_addset(mysys, (long)rollsym);
2163    P_addset(mysys, (long)t1sym);
2164    P_addset(mysys, (long)t2sym);
2165    P_addset(mysys, (long)h1sym);
2166    P_addset(mysys, (long)h2sym);
2167    P_addset(mysys, (long)gapsym);
2168    P_addset(mysys, (long)edge_effect1sym);
2169    P_addset(mysys, (long)edge_effect2sym);
2170    P_addset(mysys, (long)homsym);
2171    P_addset(mysys, (long)dbnsym);
2172    do {
2173      test__(mysys, "illegal parameter", &V);
2174      sym1 = *V.sym;
2175      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2176
2177      switch (sym1) {
2178
2179      case lsym:
2180        QL = EVAL_(&V);
2181        break;
2182
2183      case ksym:
2184        QK = EVAL_(&V);
2185        break;
2186
2187      case nsym:
2188        k1 = (long)floor(EVAL_(&V) + 0.5);
2189        break;
2190
2191      case tsym:
2192        t = EVAL_(&V);
2193        break;
2194
2195      case rollsym:
2196        dt = EVAL_(&V);
2197        break;
2198
2199      case t1sym:
2200        t1 = EVAL_(&V);
2201        break;
2202
2203      case t2sym:
2204        t2 = EVAL_(&V);
2205        break;
2206
2207        case h1sym:
2208        h1 = EVAL_(&V);
2209        break;
2210
2211      case h2sym:
2212        h2 = EVAL_(&V);
2213        break;
2214       
2215      case gapsym:
2216        gap = EVAL_(&V);
2217        break;
2218
2219      case edge_effect1sym:
2220        edge_effect1 = (long)EVAL_(&V);
2221        break;
2222
2223      case edge_effect2sym:
2224        edge_effect2 = (long)EVAL_(&V);
2225        break;
2226
2227      case mthsym:
2228        k2 = (long)floor(EVAL_(&V) + 0.5);
2229        if (k2 != Meth_Linear) globval.MatMeth = false;
2230        if ((unsigned int)k2 >= 32 ||
2231            ((1 << k2) & ((1 << Meth_Linear) | (1 << Meth_Second) |
2232                          (1 << Meth_Fourth))) == 0)
2233          getest__(P_expset(SET, 0), "Check integrator..", &V);
2234        break;
2235
2236      case homsym:
2237        GetHOM(&V);
2238        break;
2239
2240      case dbnsym:
2241        GetDBN_(&V);
2242        break;
2243      default:
2244        break;
2245      }
2246      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2247             "<, > or <;> expected", &V);
2248      if (*V.sym == comma)
2249        GetSym__(&V);
2250    } while (P_inset(*V.sym, mysys));
2251    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2252    GetSym__(&V);
2253    globval.Elem_nFam++;
2254    if (globval.Elem_nFam <= Elem_nFamMax) {
2255      WITH = &ElemFam[globval.Elem_nFam-1];
2256      WITH1 = &WITH->ElemF;
2257      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2258      WITH1->PL = QL;
2259      WITH1->Pkind = Mpole;
2260      Mpole_Alloc(&WITH->ElemF);
2261      WITH2 = WITH1->M;
2262      WITH2->Pmethod = k2;
2263      WITH2->PN = k1;
2264      if (WITH1->PL != 0.0)
2265        WITH2->Pirho = t * M_PI / 180.0 / WITH1->PL;
2266      else
2267        WITH2->Pirho = t * M_PI / 180.0;
2268      WITH2->PTx1 = t1; WITH2->PTx2 = t2; //entrance and exit angle of the dipoles (relative to rectangular magnets)
2269      WITH2->PH1 = h1; WITH2->PH2 = h2; //entrance and exit angle of the dipoles
2270      WITH2->Pgap = gap;
2271      WITH2->dipEdge_effect1 = edge_effect1;//edge_effect effect at the entrance
2272      WITH2->dipEdge_effect2 = edge_effect2;//edge effect at the exit
2273      WITH2->n_design = Dip;
2274      AssignHOM(globval.Elem_nFam, &V);
2275      SetDBN(&V);
2276      WITH2->PBpar[HOMmax+2] = QK; WITH2->PdTpar = dt;
2277    } else {
2278      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2279             globval.Elem_nFam, (long)Elem_nFamMax);
2280      exit_(1);
2281    }
2282    break;
2283   
2284    /**************************************************************************
2285      Quadrupole
2286    **************************************************************************
2287
2288    <name>: Quadrupole,
2289            L=<length>, ( [m] )
2290            K =<K-value>, ( [m-2] )
2291            N =<# of kicks>,
2292            Method=<method>,
2293            FF1, FF1 = 1 means scaling factor entrance, exit
2294            FFscaling = Fringe field scaling factor, default 1.0,
2295            Roll or tilt =<roll angle>, ( [deg], design roll angle )
2296            HOM=(i, <Bi>, <Ai>, ( higher order component in USA notation )
2297                 j, <Bj>, <Aj>, ( Systematic error Only )
2298                 ............    ( Random errors are assigned )
2299                 n, <Bn>, <An>); ( in a Program File using procedures )
2300
2301    Example
2302
2303      Q1: Quadrupole, L=0.5, K=2.213455, N=4, Method=4;
2304      Q1 : Quadrupole, L=0.5, K=2.213455, N=4, FF1 =1, FF2=0, FFscaling=1, Method=4;
2305
2306    **************************************************************/
2307  case qdsym:  /*4*/
2308    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2309    GetSym__(&V);
2310    QL = 0.0;   /* L */
2311    QK = 0.0;   /* K */
2312    k1 = 1;   /* N */
2313    k2 = Meth_Fourth;   /* method */
2314    dt = 0.0;
2315    FF1 = 0;     /* Entrance Fringe field */
2316    FF2 = 0;     /* Exit Fringe field */
2317    FFscaling = 1.0; /*Fringe field scaling factor */
2318    ClearHOMandDBN(&V);
2319    P_addset(P_expset(mysys, 0), (long)lsym);
2320    P_addset(mysys, (long)ksym);
2321    P_addset(mysys, (long)nsym);
2322    P_addset(mysys, (long)mthsym);
2323    P_addset(mysys, (long)rollsym);
2324    P_addset(mysys, (long)tiltsym);
2325    P_addset(mysys, (long)homsym);
2326    P_addset(mysys, (long)dbnsym);
2327    P_addset(mysys, (long)ff1sym);
2328    P_addset(mysys, (long)ff2sym);
2329    P_addset(mysys, (long)ffscalingsym);
2330    do {   /*5: read L, K, N, T, T1, T2 */
2331      test__(mysys, "illegal parameter", &V);
2332      sym1 = *V.sym;
2333      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2334      switch (sym1) {   /*6*/
2335
2336      case lsym:
2337        QL = EVAL_(&V);
2338        break;
2339
2340      case ffscalingsym:     // read quad ff scaling factor, default 1.0
2341      FFscaling = EVAL_(&V);
2342      break;
2343
2344      case ff1sym:
2345           FF1 = (long)EVAL_(&V);
2346           break;
2347
2348      case ff2sym:
2349           FF2 = (long)EVAL_(&V);
2350           break;
2351
2352      case ksym:
2353        QK = EVAL_(&V);
2354        break;
2355
2356      case nsym:
2357        k1 = (long)floor(EVAL_(&V) + 0.5);
2358        break;
2359
2360      case mthsym:
2361        k2 = (long)floor(EVAL_(&V) + 0.5);
2362        if (k2 != Meth_Linear) globval.MatMeth = false;
2363        if ((unsigned int)k2 >= 32 ||
2364            ((1 << k2) & ((1 << Meth_Linear) | (1 << Meth_First) |
2365                          (1 << Meth_Second) | (1 << Meth_Fourth))) == 0)
2366          getest__(P_expset(SET, 0), "Check integrator..", &V);
2367        break;
2368
2369      case rollsym:
2370        dt = EVAL_(&V);
2371        break;
2372
2373      case tiltsym:
2374        dt = EVAL_(&V);
2375        break;
2376
2377      case homsym:
2378        GetHOM(&V);
2379        break;
2380
2381      case dbnsym:
2382        GetDBN_(&V);
2383        break;
2384      default:
2385        break;
2386      }
2387      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2388             "<, > or <;> expected", &V);
2389      if (*V.sym == comma)
2390        GetSym__(&V);
2391    } while (P_inset(*V.sym, mysys));   /*5*/
2392    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2393    GetSym__(&V);
2394    globval.Elem_nFam++;
2395    if (globval.Elem_nFam <= Elem_nFamMax) {
2396      WITH = &ElemFam[globval.Elem_nFam-1];
2397      WITH1 = &WITH->ElemF;
2398      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2399      WITH1->PL = QL; WITH1->Pkind = Mpole;
2400      Mpole_Alloc(&WITH->ElemF);
2401      WITH2 = WITH1->M;
2402      WITH2->Pmethod = k2; WITH2->PN = k1; WITH2->PdTpar = dt;
2403      WITH2->quadFF1 = FF1; /* entrance fringe field flag */
2404      WITH2->quadFF2 = FF2; /* exit fringe field flag */
2405      WITH2->quadFFscaling = FFscaling; /*fringe field scaling factor flag */
2406          WITH2->sextFF1 = 0; /* entrance sextupole fringe field flag */
2407       WITH2->sextFF2 = 0; /* exit sextupole fringe field flag */
2408
2409      AssignHOM(globval.Elem_nFam, &V);
2410      SetDBN(&V);
2411      WITH2->n_design = Quad; WITH2->PBpar[HOMmax+2] = QK;
2412    } else {
2413      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2414             globval.Elem_nFam, (long)Elem_nFamMax);
2415      exit_(1);
2416    }
2417    break;
2418
2419    /**************************************************************************
2420      Sextupole
2421    ***************************************************************************
2422
2423    <name>: Sextupole,
2424            L=<length>, ( [m] )
2425            K =<K-value>, ( [m-3] )
2426            Roll=<roll angle>, ( [degree], design roll angle )
2427            HOM=(i, <Bi>, <Ai>, ( higher order component in USA notation )
2428                 j, <Bj>, <Aj>, ( Systematic error Only )
2429                 ............    ( Random errors are assigned )
2430                 n, <Bn>, <An>); ( in a Program File using procedures )
2431
2432    Example
2433
2434      SF: Sextupole, K=-10.236345;
2435
2436    **************************************************************************/
2437  case sexsym:  /*4*/
2438    QL = 0.0;   /* L */
2439    QK = 0.0;   /* K */
2440    k1 = 1;   /* N */
2441    k2 = Meth_Fourth;   /* method */
2442    FF1 = 0;     /* Entrance Fringe field */
2443    FF2 = 0;     /* Exit Fringe field */
2444    dt = 0.0;
2445    ClearHOMandDBN(&V);
2446    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2447             "<, > or <;> expected", &V);
2448    if (*V.sym == comma) {
2449      GetSym__(&V);
2450      P_addset(P_expset(mysys, 0), (long)lsym);
2451      P_addset(mysys, (long)ksym);
2452      P_addset(mysys, (long)nsym);
2453      P_addset(mysys, (long)mthsym);
2454      P_addset(mysys, (long)rollsym);
2455      P_addset(mysys, (long)homsym);
2456      P_addset(mysys, (long)dbnsym);
2457      P_addset(mysys, (long)ff1sym);
2458      P_addset(mysys, (long)ff2sym);
2459      do {   /*5: read L, K, N, T, T1, T2 */
2460        test__(mysys, "illegal parameter", &V);
2461        sym1 = *V.sym;
2462        getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2463        switch (sym1)
2464          {   /*6*/
2465          case lsym:
2466            QL = EVAL_(&V);
2467            break;
2468
2469          case ksym:
2470            QK = EVAL_(&V);
2471            break;
2472
2473          case nsym:
2474            k1 = (long)floor(EVAL_(&V) + 0.5);
2475            break;
2476
2477          case ff1sym:
2478        FF1 = (long)EVAL_(&V);
2479        break;
2480
2481      case ff2sym:
2482        FF2 = (long)EVAL_(&V);
2483        break;
2484
2485          case mthsym:
2486            k2 = (long)floor(EVAL_(&V) + 0.5);
2487            if (k2 != Meth_Linear) globval.MatMeth = false;
2488            if ((unsigned int)k2 >= 32 ||
2489                ((1 << k2) & ((1 << Meth_Linear) | (1 << Meth_Second) |
2490                              (1 << Meth_Fourth))) == 0)
2491              getest__(P_expset(SET, 0), "Check integrator..", &V);
2492            break;
2493
2494          case rollsym:
2495            dt = EVAL_(&V);
2496            break;
2497
2498          case homsym:
2499            GetHOM(&V);
2500            break;
2501
2502          case dbnsym:
2503            GetDBN_(&V);
2504            break;
2505          default:
2506            break;
2507          }
2508
2509        test__(P_expset(SET,
2510                        (1 << ((long)comma)) | (1 << ((long)semicolon))),
2511               "<, > or <;> expected", &V);
2512
2513        if (*V.sym == comma)
2514          GetSym__(&V);
2515
2516      } while (P_inset(*V.sym, mysys));   /*5*/
2517      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2518    }
2519    GetSym__(&V);
2520    globval.Elem_nFam++;
2521    if (globval.Elem_nFam <= Elem_nFamMax) {
2522      WITH = &ElemFam[globval.Elem_nFam-1];
2523      WITH1 = &WITH->ElemF;
2524      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2525      WITH1->PL = QL;
2526      WITH1->Pkind = Mpole;
2527      Mpole_Alloc(&WITH->ElemF);
2528      WITH2 = WITH1->M;
2529      WITH2->Pmethod = k2;
2530      WITH2->PN = k1;
2531      WITH2->quadFF1 = 0; /* entrance fringe field flag */
2532      WITH2->quadFF2 = 0; /* exit fringe field flag */
2533      WITH2->sextFF1 = FF1; /* entrance fringe field flag */
2534      WITH2->sextFF2 = FF2; /* exit fringe field flag */
2535      if (WITH1->PL != 0.0)
2536        WITH2->Pthick = pthicktype(thick);
2537      else
2538        WITH2->Pthick = pthicktype(thin);
2539      WITH2->PdTpar = dt; WITH2->n_design = Sext;
2540      AssignHOM(globval.Elem_nFam, &V);
2541      SetDBN(&V);
2542      WITH2->PBpar[HOMmax + 3] = QK;
2543    } else {
2544      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2545             globval.Elem_nFam, (long)Elem_nFamMax);
2546      exit_(1);
2547    }
2548    break;
2549
2550    /**************************************************************************
2551      Cavity
2552    ***************************************************************************
2553
2554    <name>: Cavity,
2555            Frequency = <Frf>,   ( [Hz] )
2556            Voltage   = <Vrf>,   ( [V]  )
2557            Phase     = <phi_rf> (degrees)
2558            harnum    = <h>
2559
2560    Example
2561
2562      CAV: Cavity, Frequency = 499.95e6, Voltage=1.22e6, harnum=328;
2563
2564    **************************************************************************/
2565  case cavsym:
2566    ClearHOMandDBN(&V);
2567    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2568    GetSym__(&V);
2569    Frf = 0.0;   /* Frf */
2570    Vrf = 0.0;   /* Vrf */
2571    QPhi = 0.0;
2572    harnum = 0;   /* Voff */
2573    P_addset(P_expset(mysys, 0), (long)frqsym);
2574    P_addset(mysys, (long)vrfsym);
2575    P_addset(mysys, (long)phisym);
2576    P_addset(mysys, (long)harnumsym);
2577    P_addset(mysys, (long)dbnsym);
2578    do {
2579      test__(mysys, "illegal parameter", &V);
2580      sym1 = *V.sym;
2581      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2582      switch (sym1) {
2583
2584      case frqsym:
2585        Frf = EVAL_(&V);
2586        break;
2587
2588      case vrfsym:
2589        Vrf = EVAL_(&V);
2590        break;
2591
2592      case phisym:
2593        QPhi = EVAL_(&V);
2594        break;
2595
2596      case harnumsym:
2597        harnum = (long)floor(EVAL_(&V) + 0.5);
2598        break;
2599
2600      case dbnsym:
2601        GetDBN_(&V);
2602        break;
2603      default:
2604        break;
2605      }
2606      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2607             "<, > or <;> expected", &V);
2608      if (*V.sym == comma)
2609        GetSym__(&V);
2610    } while (P_inset(*V.sym, mysys));
2611    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2612    GetSym__(&V);
2613    globval.Elem_nFam++;
2614    if (globval.Elem_nFam <= Elem_nFamMax) {
2615      WITH = &ElemFam[globval.Elem_nFam-1];
2616      WITH1 = &WITH->ElemF;
2617      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2618      WITH1->Pkind = Cavity;
2619      Cav_Alloc(&WITH->ElemF);
2620      WITH3 = WITH1->C;
2621      WITH3->Pvolt = Vrf;   /* Voltage [V] */
2622      WITH3->Pfreq = Frf;   /* Frequency in Hz */
2623      WITH3->phi = QPhi*M_PI/180.0;
2624      WITH3->Ph = harnum;  /* RF harmonic number */
2625      SetDBN(&V);
2626    } else {
2627      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2628             globval.Elem_nFam, (long)Elem_nFamMax);
2629      exit_(1);
2630    }
2631    break;
2632
2633    /**************************************************************************
2634      Corrector
2635    ***************************************************************************
2636   
2637      Kickers specific for orbit correction.
2638   
2639    <name>: Corrector, <direction>, L=<length>, kick = <kick angle [rad]>;
2640
2641    <name> :== Alphanumeric string. Up to NameLength character length.
2642              BEGIN with an alphabet.
2643    <direction> :== 'horizontal'|'vertical'
2644
2645    Example
2646
2647      COH: Corrector, horizontal;
2648
2649    **************************************************************************/
2650
2651  case corsym:  /*4*/
2652    QL = 0.0;   /* L */
2653    QKick = 0.0; /* kick angle of the corrector [rad]*/
2654    Kplane = 0;   /* 1 is horizontal corrector, -1 is vertical corrector */
2655    k1 = 1;     /* N */
2656    k2 = Meth_Linear;   /* method */
2657    dt = 0.0;
2658    ClearHOMandDBN(&V);
2659    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2660    if (*V.sym == comma) {
2661      GetSym__(&V);
2662      P_addset(P_expset(mysys, 0), (long)lsym);
2663      P_addset(mysys, (long)nsym);
2664      P_addset(mysys, (long)mthsym);
2665      P_addset(mysys, (long)horsym);
2666      P_addset(mysys, (long)versym);
2667      P_addset(mysys, (long)corkicksym);
2668      P_addset(mysys, (long)rollsym);
2669      P_addset(mysys, (long)dbnsym);
2670      do {   /*5: read L, K, N, T, T1, T2 */
2671        test__(mysys, "illegal parameter", &V); sym1 = *V.sym;
2672        if (*V.sym == (long)dbnsym || *V.sym == (long)rollsym ||
2673            *V.sym == (long)mthsym || *V.sym == (long)nsym || 
2674            *V.sym == (long)lsym || *V.sym == (long)corkicksym)
2675          {
2676            getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2677            if (*V.sym == eql) {
2678              switch (sym1) {   /*6*/
2679
2680              case lsym:
2681                QL = EVAL_(&V);
2682                break;
2683
2684                 case corkicksym:
2685                QKick = EVAL_(&V);
2686                break; 
2687               
2688              case nsym:
2689                k1 = (long)floor(EVAL_(&V) + 0.5);
2690                break;
2691
2692              case mthsym:
2693                k2 = (long)floor(EVAL_(&V) + 0.5);
2694                if (k2 != Meth_Linear) globval.MatMeth = false;
2695                if ((unsigned int)k2 >= 32 ||
2696                    ((1 << k2) & ((1 << Meth_Linear) | (1 << Meth_Second) |
2697                                  (1 << Meth_Fourth))) == 0)
2698                  getest__(P_expset(SET2, 0), "Check integrator..", &V);
2699                break;
2700
2701              case rollsym:
2702                dt = EVAL_(&V);
2703                break;
2704              case dbnsym:
2705                GetDBN_(&V);
2706                break;
2707              default:
2708                break;
2709              }
2710            }
2711          } else {
2712            if (sym1 == horsym)
2713              Kplane = 1;
2714            else if (sym1 == versym)
2715              Kplane = -1;
2716            GetSym__(&V);
2717          }
2718        test__(P_expset(SET,
2719                        (1 << ((long)comma)) | (1 << ((long)semicolon))),
2720               "<, > or <;> expected", &V);
2721        if (*V.sym == comma)
2722          GetSym__(&V);
2723      } while (P_inset(*V.sym, mysys));   /*5*/
2724
2725      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2726    }
2727    GetSym__(&V);
2728    globval.Elem_nFam++;
2729    if (globval.Elem_nFam <= Elem_nFamMax) {
2730      WITH = &ElemFam[globval.Elem_nFam-1];
2731      WITH1 = &WITH->ElemF;
2732      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2733      WITH1->PL = QL;
2734      WITH1->Pkind = Mpole;
2735      Mpole_Alloc(&WITH->ElemF);
2736      WITH2 = WITH1->M;
2737      SetDBN(&V);
2738      if (WITH1->PL != 0.0)
2739        WITH2->Pthick = pthicktype(thick);
2740      else
2741        WITH2->Pthick = pthicktype(thin);
2742      WITH2->Pmethod = k2;
2743      WITH2->PN = k1;
2744      WITH2->PdTpar = dt;
2745
2746        if(Kplane == 0){
2747                cout << "t2lat: Error! Must specify the type of the corrector, Horizontal or vertical!" << endl;
2748                exit_(1);
2749            }
2750      WITH2->PBpar[Kplane*Dip + HOMmax] = -1*QKick;  //assign the kick angle [rad]
2751 
2752   
2753   
2754    } else {
2755      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2756             globval.Elem_nFam, (long)Elem_nFamMax);
2757      exit_(1);
2758    }
2759    break;
2760
2761    /**************************************************************************
2762      Beam Position Monitor
2763    ***************************************************************************
2764
2765    <name>: Beam Position Monitor;
2766
2767    <name>:== Alphanumeric string. Up to NameLength character length.
2768              BEGIN with an alphabet.
2769
2770    Example
2771
2772      BPM: Beam Position Monitor;
2773
2774    **************************************************************************/
2775
2776  case bemsym:
2777    ClearHOMandDBN(&V);
2778    getest__(P_addset(P_expset(SET3, 0), (long)possym),
2779             "<position> expected", &V);
2780    getest__(P_expset(SET, 1 << ((long)monsym)), "<monitor> expected", &V);
2781    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2782             "<, > or <;> expected", &V);
2783    if (*V.sym == comma) {
2784      getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
2785               "illegal parameter", &V);
2786      sym1 = *V.sym;
2787      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2788      if (sym1 == dbnsym)
2789        GetDBN_(&V);
2790      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
2791    }
2792    GetSym__(&V);
2793    globval.Elem_nFam++;
2794    if (globval.Elem_nFam <= Elem_nFamMax) {
2795      WITH = &ElemFam[globval.Elem_nFam-1];
2796      WITH1 = &WITH->ElemF;
2797      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2798      WITH1->Pkind = Mpole;
2799      Mpole_Alloc(&WITH->ElemF);
2800      WITH2 = WITH1->M;
2801      WITH2->Pthick = pthicktype(thin);
2802      SetDBN(&V);
2803    } else {
2804      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2805             globval.Elem_nFam, (long)Elem_nFamMax);
2806      exit_(1);
2807    }
2808    break;
2809
2810
2811    /**************************************************************************
2812      Marker
2813    ***************************************************************************
2814
2815    <name>: Marker;
2816
2817    <name>:== Alphanumeric string. Up to NameLength character length.
2818              BEGIN with an alphabet.
2819
2820    Example
2821
2822      SYM: Marker;
2823
2824    **************************************************************************/
2825
2826  case mrksym:
2827    ClearHOMandDBN(&V);
2828    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
2829             "<, > or <;> expected", &V);
2830    if (*V.sym == comma) {
2831      getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
2832               "illegal parameter", &V);
2833      sym1 = *V.sym;
2834      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2835      if (sym1 == dbnsym)
2836        GetDBN_(&V);
2837      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
2838    }
2839    GetSym__(&V);
2840    globval.Elem_nFam++;
2841    if (globval.Elem_nFam <= Elem_nFamMax) {
2842      WITH = &ElemFam[globval.Elem_nFam-1];
2843      WITH1 = &WITH->ElemF;
2844      memcpy(WITH1->PName, ElementName, sizeof(partsName));
2845      WITH1->PL = 0.0;
2846      WITH1->Pkind = PartsKind(marker);
2847      SetDBN(&V);
2848    } else {
2849      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2850             globval.Elem_nFam, (long)Elem_nFamMax);
2851      exit_(1);
2852    }
2853    break;
2854
2855   
2856    /**************************************************************************
2857      Ghost
2858    ***************************************************************************
2859
2860     <name>: Ghost;
2861
2862     <name>:== Alphanumeric string. Up to NameLength character length.
2863               BEGIN with an alphabet.
2864
2865     Example
2866
2867       OBAKE : Ghost;
2868
2869    **************************************************************************/
2870    /*----------->>>
2871      GstSym:BEGIN
2872      getest([comma], '<, > expexted');
2873      getest([typsym], '<type> expected');
2874      getest([eql], '<=> expected');
2875      QL:=Eval;
2876      test([semicolon], '<;> expected');
2877      getsym;
2878      if sym=DBNsym then GetDBN;
2879      globval.Elem_nFam := globval.Elem_nFam + 1;
2880      if globval.Elem_nFam <= Elem_nFamMax then
2881      begin
2882      with ElemFam[globval.Elem_nFam].ElemF do
2883      with ElementT[globval.Elem_nFam] do
2884      BEGIN
2885      Pname:=ElementName; Pkind:=Ghost; PN:=round(QL);
2886      SetDBN;
2887      END;
2888      end
2889      else
2890      writeln('Elem_nFamMax exceeded: ', globval.Elem_nFam:1,
2891      '(', Elem_nFamMax:1, ')');
2892      END;
2893      <<-----------------------------*/
2894
2895
2896    /**************************************************************************
2897      Multipole
2898    ***************************************************************************
2899
2900    <name>: Multipole,
2901            L=<length>, ( [m] )
2902            T =<bending angle>, ( [degree] )
2903            T1=<entrance angle>, ( [degree] )
2904            T2=<exit angle>, ( [degree] )
2905            Roll=<roll angle>, ( [deg], design roll angle )
2906            N =<# of kicks>,
2907            method=<method>, ( 2 or 4. The method to divide Q into slices.)
2908                    ( The detail of <method> will be discussed later.)
2909            Default value is 2.
2910            HOM=(i, <Bi>, <Ai>, ( higher order component in USA notation )
2911                 j, <Bj>, <Aj>, ( Systematic error Only )
2912                 ............    ( Random errors are assigned )
2913                 n, <Bn>, <An>); ( in a Program File using procedures )
2914
2915    Example
2916
2917      B: multipole, L=0.70, T=10.0, T1=5.0, T2=5.0,
2918         HOM=(2, -1.0, 0), N=8, Method=2;
2919
2920
2921      QF: multipole, L=0.70,
2922          HOM=(2, 2.50, 0.0,
2923               4, 1.01e7, 0.0),
2924          N=8, Method=2;
2925
2926    **************************************************************************/
2927
2928  case mpsym:  /*4*/
2929    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2930    GetSym__(&V);
2931    QL = 0.0;   /* L */
2932    QK = 0.0;   /* K */
2933    k1 = 1;   /* N */
2934    t = 0.0;   /* T */
2935    t1 = 0.0;   /* T1 */
2936    t2 = 0.0;   /* T2 */
2937    h1 = 0.0;
2938    h2 = 0.0;
2939    gap = 0.0;   /* gap */
2940    k2 = Meth_Fourth;   /* method */
2941    dt = 0.0;
2942    ClearHOMandDBN(&V);
2943    P_addset(P_expset(mysys, 0), (long)lsym);
2944    P_addset(mysys, (long)nsym);
2945    P_addset(mysys, (long)mthsym);
2946    P_addset(mysys, (long)tsym);
2947    P_addset(mysys, (long)t1sym);
2948    P_addset(mysys, (long)t2sym);
2949    P_addset(mysys, (long)h1sym);
2950    P_addset(mysys, (long)h2sym);
2951    P_addset(mysys, (long)gapsym);
2952    P_addset(mysys, (long)rollsym);
2953    P_addset(mysys, (long)homsym);
2954    P_addset(mysys, (long)dbnsym);
2955    do {   /* read L, K, N */
2956      test__(mysys, "illegal parameter", &V);
2957      sym1 = *V.sym;
2958      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2959      switch (sym1) {
2960
2961      case lsym:
2962        QL = EVAL_(&V);
2963        break;
2964
2965      case nsym:
2966        k1 = (long)floor(EVAL_(&V) + 0.5);
2967        break;
2968
2969      case tsym:
2970        t = EVAL_(&V);
2971        break;
2972
2973      case rollsym:
2974        dt = EVAL_(&V);
2975        break;
2976
2977      case t1sym:
2978        t1 = EVAL_(&V);
2979        break;
2980
2981      case t2sym:
2982        t2 = EVAL_(&V);
2983        break;
2984
2985      case h1sym:
2986        h1 = EVAL_(&V);
2987        break;
2988
2989      case h2sym:
2990        h2 = EVAL_(&V);
2991        break;
2992       
2993      case gapsym:
2994        gap = EVAL_(&V);
2995        break;
2996
2997      case mthsym:
2998        k2 = (long)floor(EVAL_(&V) + 0.5);
2999        if (k2 != Meth_Linear) globval.MatMeth = false;
3000        if ((unsigned int)k2 >= 32 ||
3001            ((1 << k2) & ((1 << Meth_Linear) | (1 << Meth_Second) |
3002                          (1 << Meth_Fourth))) == 0)
3003          getest__(P_expset(SET, 0), "Check integrator..", &V);
3004        break;
3005
3006      case homsym:
3007        GetHOM(&V);
3008        break;
3009
3010      case dbnsym:
3011        GetDBN_(&V);
3012        break;
3013      default:
3014        break;
3015      }
3016      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3017             "<, > or <;> expected", &V);
3018      if (*V.sym == comma)
3019        GetSym__(&V);
3020    } while (P_inset(*V.sym, mysys));
3021    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
3022    GetSym__(&V);
3023    globval.Elem_nFam++;
3024    if (globval.Elem_nFam <= Elem_nFamMax) {
3025      WITH = &ElemFam[globval.Elem_nFam-1];
3026      WITH1 = &WITH->ElemF;
3027      Mpole_Alloc(&WITH->ElemF);
3028      WITH2 = WITH1->M;
3029      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3030      WITH1->Pkind = Mpole;
3031      WITH1->PL = QL;
3032      if (WITH1->PL != 0e0) {
3033        WITH2->Pthick = pthicktype(thick);
3034        WITH2->Pirho = t * M_PI / 180.0 / WITH1->PL;
3035      } else {
3036        WITH2->Pthick = pthicktype(thin);
3037        WITH2->Pirho = t * M_PI / 180.0;
3038      }
3039      WITH2->PN = k1; WITH2->Pmethod = k2;
3040      WITH2->PTx1 = t1; WITH2->PTx2 = t2;
3041      WITH2->PH1 = h1; WITH2->PH2 = h2;
3042      WITH2->Pgap = gap;
3043      WITH2->PdTpar = dt;
3044      AssignHOM(globval.Elem_nFam, &V);
3045      WITH2->n_design = WITH2->Porder;
3046      SetDBN(&V);
3047    } else {
3048      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3049             globval.Elem_nFam, (long)Elem_nFamMax);
3050      exit_(1);
3051    }
3052    break;
3053
3054    /************************************************************************
3055      Wiggler
3056    *************************************************************************
3057
3058    <name>: Wiggler,
3059            L       = <length [m]>,
3060            BoBrhoV = <B/Brho [1/m]>,
3061            BoBrhoH = <B/Brho [1/m]>,
3062            Lambda  = <period [m]>,
3063            kxV     = <[m]>,
3064            kxH     = <[m]>,
3065            phi     = <phase [deg]>,
3066            harm(n, kxV, BoBrhoV, kxH, BoBrhoH, phi)
3067            ...
3068            N       = <no of integration steps>,
3069            Method  = <method>,
3070
3071    Example
3072
3073      U143: wiggler, L=4.80, K=0.5, Lambda=0.15, N=20, Method=0;
3074
3075      EPU:  wiggler, L=4.80, Lambda=0.15, N=20, Method=0,
3076            harm=(3, kxV_3, BoBrhoV_3, kxH_3, BoBrhoH_3, phi_3,
3077                  ...
3078                  5, kxV_5, BoBrhoV_5, kxH_5, BoBrhoH_5, phi_5);
3079 
3080    **************************************************************************/
3081
3082  case wglsym:
3083    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3084    GetSym__(&V);
3085    QL = 0e0;
3086    QK = 0e0; 
3087    QKV = 0e0; 
3088    QKH = 0e0; 
3089    QKxV = 0e0; 
3090    QKxH = 0e0;
3091    QPhi = 0e0; 
3092    QKS = 0e0; 
3093    k1 = 1; 
3094    k2 = Meth_Fourth; 
3095    dt = 0e0;
3096    ClearHOMandDBN(&V);
3097    P_addset(P_expset(mysys, 0), (long)lsym);
3098    P_addset(mysys, (long)lmdsym);
3099    P_addset(mysys, (long)bobrhovsym);
3100    P_addset(mysys, (long)bobrhohsym);
3101    P_addset(mysys, (long)kxvsym);
3102    P_addset(mysys, (long)kxhsym);
3103    P_addset(mysys, (long)phisym);
3104    P_addset(mysys, (long)harmsym);
3105    P_addset(mysys, (long)nsym);
3106    P_addset(mysys, (long)mthsym);
3107    P_addset(mysys, (long)rollsym);
3108    P_addset(mysys, (long)dbnsym);
3109    do {
3110      test__(mysys, "illegal parameter", &V);
3111      sym1 = *V.sym;
3112      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3113      switch (sym1) {   /*6*/
3114           
3115      case lsym:
3116        QL = EVAL_(&V);
3117        break;
3118
3119      case bobrhovsym:
3120        QKV = EVAL_(&V);
3121        break;
3122
3123      case bobrhohsym:
3124        QKH = EVAL_(&V);
3125        break;
3126
3127      case kxvsym:
3128        QKxV = EVAL_(&V);
3129        break;
3130
3131      case kxhsym:
3132        QKxH = EVAL_(&V);
3133        break;
3134
3135      case phisym:
3136        QPhi = EVAL_(&V);
3137        break;
3138
3139      case nsym:
3140        k1 = (long)floor(EVAL_(&V) + 0.5);
3141        break;
3142
3143      case mthsym:
3144        k2 = (long)floor(EVAL_(&V) + 0.5);
3145        if (k2 != Meth_Linear) globval.MatMeth = false;
3146        if ((unsigned int)k2 >= 32 ||
3147            ((1 << k2) &
3148             ((1 << Meth_Linear) | (1 << Meth_First) | (1 << Meth_Second) |
3149              (1 << Meth_Fourth) | (1 << Meth_genfun))) == 0)
3150          getest__(P_expset(SET, 0), "Check integrator..", &V);
3151        break;
3152
3153      case lmdsym:
3154        QKS = EVAL_(&V);
3155        break;
3156
3157      case rollsym:
3158        dt = EVAL_(&V);
3159        break;
3160
3161      case harmsym:
3162        GetHarm(&V);
3163        break;
3164
3165      case dbnsym:
3166        GetDBN_(&V);
3167        break;
3168
3169      default:
3170        break;
3171      }
3172      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3173             "<, > or <;> expected", &V);
3174      if (*V.sym == comma)
3175        GetSym__(&V);
3176    } while (P_inset(*V.sym, mysys));   /*5*/
3177    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3178    GetSym__(&V);
3179    globval.Elem_nFam++;
3180    if (globval.Elem_nFam <= Elem_nFamMax) {
3181      WITH = &ElemFam[globval.Elem_nFam-1]; WITH1 = &WITH->ElemF;
3182      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3183      WITH1->PL = QL; WITH1->Pkind = Wigl;
3184      Wiggler_Alloc(&WITH->ElemF); WITH4 = WITH1->W;
3185      WITH4->Pmethod = k2; WITH4->PN = k1;
3186      WITH4->PdTpar = dt;
3187      SetDBN(&V);
3188      WITH4->lambda = QKS; WITH4->n_harm = 1; WITH4->harm[0] = 1;
3189      WITH4->kxV[0] = QKxV; WITH4->BoBrhoV[0] = QKV;
3190      WITH4->kxH[0] = QKxH; WITH4->BoBrhoH[0] = QKH;
3191      WITH4->phi[0] = QPhi;
3192      AssignHarm(globval.Elem_nFam, &V);
3193      /* Equivalent vertically focusing gradient */
3194      WITH4->PBW[HOMmax+2] = -QK*QK/2e0;
3195      CheckWiggler(globval.Elem_nFam, &V);
3196    } else {
3197      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3198             globval.Elem_nFam, (long)Elem_nFamMax);
3199      exit_(1);
3200    }
3201    break;
3202
3203    /************************************************************************
3204      Field Map
3205    *************************************************************************
3206
3207    <name> : Fieldmap,
3208             L     = <length [m]>,
3209             N     = <no of integration steps>,
3210             file1 = <file name (lower case)>
3211 
3212    Example
3213
3214      FM: Fieldmap, L = 1.0, N = 20, file1 = "U19_Bxyz.dat";
3215
3216    **************************************************************************/
3217
3218  case fmsym:
3219    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3220    GetSym__(&V);
3221    QL = 0.0; 
3222    k1 = 1; 
3223    strcpy(str1, ""); 
3224    strcpy(str2, "");
3225    P_addset(P_expset(mysys, 0), (long)lsym);
3226    P_addset(mysys, (long)nsym);
3227    P_addset(mysys, (long)fnamesym1);
3228    P_addset(mysys, (long)fnamesym2);
3229    do {
3230      test__(mysys, "illegal parameter", &V);
3231      sym1 = *V.sym;
3232      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3233      switch (sym1) {   /*6*/
3234           
3235      case lsym:
3236        QL = EVAL_(&V);
3237        break;
3238
3239      case nsym:
3240        k1 = (long)floor(EVAL_(&V) + 0.5);
3241        break;
3242
3243      case fnamesym1:
3244        GetSym__(&V);
3245        for (i = 1; i < (signed)strlen(id_); i++) {
3246          if (id_[i] == '"') break;
3247          strncat(str1, &id_[i], 1);
3248        }
3249        GetSym__(&V);
3250        break;
3251
3252      default:
3253        break;
3254      }
3255      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3256             "<, > or <;> expected", &V);
3257      if (*V.sym == comma)
3258        GetSym__(&V);
3259    } while (P_inset(*V.sym, mysys));   /*5*/
3260    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3261    GetSym__(&V);
3262    globval.Elem_nFam++;
3263    if (globval.Elem_nFam <= Elem_nFamMax) {
3264      WITH = &ElemFam[globval.Elem_nFam-1]; WITH1 = &WITH->ElemF;
3265      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3266      WITH1->PL = QL; WITH1->Pkind = FieldMap;
3267      FieldMap_Alloc(WITH1, true);
3268      WITH6 = WITH1->FM; WITH6->n_step = k1;
3269      if (CheckUDItable("energy         ", LINK) != 0) { 
3270        RefUDItable("energy         ", &globval.Energy, LINK);
3271        if (strcmp(str1, "") != 0) get_B(str1, WITH6);
3272      } else {
3273        cout << "Fieldmap: energy not defined" << endl;
3274        exit_(1);
3275      }
3276    } else {
3277      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3278             globval.Elem_nFam, (long)Elem_nFamMax);
3279      exit_(1);
3280    }
3281    break;
3282
3283    /**********************************************************************
3284      Insertion introduced for SOLEIL using Radia Maps
3285    ***********************************************************************
3286         
3287    <name> : insertion,             
3288             N = <number of thin lenses>,
3289             scaling1 or 2 = scaling factor: should be 1. Default value
3290             file1 = <filename>, in lowercase (first order defaults)
3291             file2 = <filename>, in lowercase (second order defaults)
3292             method = <method>, ( 1 or 3. The method to divide Q into slices.)
3293             ( The detail of <method> will be discussed later.)
3294   
3295    Example
3296         
3297      ID1 : insertion, scaling2 = 1, N=10, file2="hu80_lh";
3298      ID2 : insertion, scaling1 = 1, N=10, file1="hu80_lh_bdl";
3299      ID3 : insertion, N=10, file1="hu80_lh_dbl"; file2="hu80_lh";
3300         
3301    Notes
3302      file1 and file2 must have the same structures and meshing
3303      optional parameter scaling must be at first (weird bug otherwise)
3304    **************************************************************************/
3305
3306  case idsym:
3307    getest__(P_expset(SET, 1L << ((long) comma)), "<, > expected", &V);
3308        GetSym__(&V);
3309        QK   = 0e0;
3310        QKxV = 0e0;
3311        QKS  = 0e0;
3312        k1 = 1; // number of slices of the lattice element
3313        k2 = 3; // 1 linear interpolation, 3 spline interpolation
3314        dt = 0e0;
3315        scaling1 = 1.0; // scaling factor
3316        scaling2 = 1.0; // scaling factor
3317        P_addset(P_expset(mysys, 0), (long) nsym);
3318        P_addset(mysys, (long) fnamesym1);
3319        P_addset(mysys, (long) fnamesym2);
3320        P_addset(mysys, (long) scalingsym1);
3321        P_addset(mysys, (long) scalingsym2);
3322        P_addset(mysys, (long) mthsym);
3323        do {
3324            test__(mysys, "illegal parameter", &V);
3325            sym1 = *V.sym;
3326            getest__(P_expset(SET, 1L << ((long) eql)), "<=> expected", &V);
3327           
3328            //read the parameters setting from the lattice
3329            switch (sym1) {
3330             
3331            case nsym: /* Read number of slices */
3332                k1 = abs((long) floor(EVAL_(&V)));
3333                GetSym__(&V);
3334                break;
3335
3336            case scalingsym1: /* read scaling factor for debugging purpose*/
3337                scaling1 = EVAL_(&V);
3338                break;
3339
3340            case scalingsym2: /* read scaling factor for debugging purpose*/
3341                scaling2 = EVAL_(&V);
3342                break;
3343
3344            case fnamesym1: /* Read filename for insertion device first order kicks*/
3345                firstflag = true;
3346                GetSym__(&V);
3347                for (i = 1; i < (signed) strlen(id_); i++) {
3348                    if (id_[i] == '"')
3349                        break;
3350                    strncat(str1, &id_[i], 1);
3351                }
3352                GetSym__(&V);
3353                break;
3354
3355            case fnamesym2: /* Read filename for insertion
3356             device second order kicks */
3357                secondflag = true;
3358                GetSym__(&V);
3359                for (i = 1; i < (signed) strlen(id_); i++) {
3360                    if (id_[i] == '"')
3361                        break;
3362                    strncat(str2, &id_[i], 1);
3363                }
3364                GetSym__(&V);
3365                break;
3366
3367            case mthsym: // method for interpolation: 1 means linear 3 spline
3368                k2 = (long) floor(EVAL_(&V));
3369                if (k2 != Meth_Linear)
3370                    globval.MatMeth = false;
3371                break;
3372            default:
3373                break;
3374            }
3375            if (*V.sym == comma)
3376                GetSym__(&V);
3377        } while (P_inset(*V.sym, mysys)); /*5*/
3378        GetSym__(&V);
3379        globval.Elem_nFam++;
3380
3381        /* Fills up the ID */
3382        if (globval.Elem_nFam <= Elem_nFamMax) {
3383            WITH = &ElemFam[globval.Elem_nFam - 1];
3384            WITH1 = &WITH->ElemF;
3385            memcpy(WITH1->PName, ElementName, sizeof(partsName));
3386            WITH1->Pkind = Insertion;
3387            Insertion_Alloc(&WITH->ElemF);
3388            WITH5 = WITH1->ID;
3389            WITH5->Pmethod = k2;
3390            WITH5->PN = k1;
3391            WITH5->scaling1 = scaling1;
3392            WITH5->scaling2 = scaling2;
3393
3394            // Check if filename given for first order kicks
3395            if (firstflag) {
3396                if (strcmp(str1, "") == 0)
3397                    strcpy(WITH5->fname1, "/*No_Filename1_Given*/");
3398                strcpy(WITH5->fname1, str1);
3399                // Read Id file for first order kicks
3400                WITH5->firstorder = true;
3401                Read_IDfile(WITH5->fname1, &WITH1->PL, &WITH5->nx1,
3402                        &WITH5->nz1, WITH5->tabx1, WITH5->tabz1, WITH5->thetax1,
3403                        WITH5->thetaz1);
3404            } else {
3405                strcpy(WITH5->fname1, "/*No_Filename1_Given*/");
3406            }
3407
3408            // Check if filename given for Second order kicks
3409            if (secondflag) {
3410                if (strcmp(str2, "") != 0)
3411                    strcpy(WITH5->fname2, "/*No_Filename2_Given*/");
3412                strcpy(WITH5->fname2, str2);
3413                WITH5->secondorder = secondflag;
3414                // Read Id file for second order kicks
3415                Read_IDfile(WITH5->fname2, &WITH1->PL, &WITH5->nx2,
3416                        &WITH5->nz2, WITH5->tabx2, WITH5->tabz2,
3417                        WITH5->thetax2, WITH5->thetaz2);
3418            } else {
3419                strcpy(WITH5->fname2, "/*No_Filename2_Given*/");
3420            }
3421
3422            // check whether no Radia filename read: something is wrong
3423            if (!firstflag && !secondflag) {
3424                printf("Error no Insertion filename found as"
3425                    " an input in lattice file\n");
3426                exit_(-1);
3427            }
3428
3429            if (k2 == 3 | k2 == 2) { // cubic interpolation
3430                WITH5->linear = false;
3431            } else { // linear interpolation
3432                WITH5->linear = true;
3433            }
3434
3435            // stuff for spline interpolation
3436            if (!WITH5->linear) {
3437              if (firstflag){
3438                WITH5->tx1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3439                WITH5->tz1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3440                WITH5->TabxOrd1 = (double *) malloc((WITH5->nx1) * sizeof(double));
3441                WITH5->TabzOrd1 = (double *) malloc((WITH5->nz1) * sizeof(double));
3442                WITH5->f2x1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3443                WITH5->f2z1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3444                Matrices4Spline(WITH5,1);}
3445
3446              if (secondflag){
3447                WITH5->tx2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3448                WITH5->tz2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3449                WITH5->TabxOrd2 = (double *) malloc((WITH5->nx2) * sizeof(double));
3450                WITH5->TabzOrd2 = (double *) malloc((WITH5->nz2) * sizeof(double));
3451                WITH5->f2x2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3452                WITH5->f2z2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3453                Matrices4Spline(WITH5,2);}
3454
3455            }
3456            // to put somewhere
3457            //      /** Free memory **/
3458            //      free(tab1);
3459            //      free(tab2);
3460            //
3461            //      free_matrix(tx,1,nz,1,nx);
3462            //      free_matrix(tz,1,nz,1,nx);
3463            //      free_matrix(f2x,1,nz,1,nx);
3464            //      free_matrix(f2z,1,nz,1,nx);
3465
3466        } else {
3467            printf("Elem_nFamMax exceeded: %ld(%ld)\n", globval.Elem_nFam,
3468                    (long) Elem_nFamMax);
3469            exit_(1);
3470        }
3471        break;
3472
3473    /**************************************************************************
3474       Spreader
3475    **************************************************************************
3476
3477    <name>: Spreader,
3478
3479    Example
3480
3481      S1: Spreader;
3482
3483    *************************************************************************/
3484
3485  case sprsym:
3486    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3487             "<, > or <;> expected", &V);
3488    if (*V.sym == comma) {
3489      getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
3490               "illegal parameter", &V);
3491      sym1 = *V.sym;
3492      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3493      if (sym1 == dbnsym)
3494        GetDBN_(&V);
3495      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3496    }
3497    GetSym__(&V);
3498    globval.Elem_nFam++;
3499    if (globval.Elem_nFam <= Elem_nFamMax) {
3500      WITH = &ElemFam[globval.Elem_nFam-1];
3501      WITH1 = &WITH->ElemF;
3502      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3503      WITH1->PL = *V.rnum;
3504      WITH1->Pkind = PartsKind(Spreader);
3505      Spreader_Alloc(&WITH->ElemF);
3506    } else {
3507      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3508             globval.Elem_nFam, (long)Elem_nFamMax);
3509      exit_(1);
3510    }
3511    break;
3512
3513    /**************************************************************************
3514       Recombiner
3515    **************************************************************************
3516
3517    <name>: Recombiner,
3518
3519    Example
3520
3521      S1: Recombiner;
3522
3523    *************************************************************************/
3524
3525  case recsym:
3526    getest__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3527             "<, > or <;> expected", &V);
3528    if (*V.sym == comma) {
3529      getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
3530               "illegal parameter", &V);
3531      sym1 = *V.sym;
3532      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3533      if (sym1 == dbnsym)
3534        GetDBN_(&V);
3535      test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3536    }
3537    GetSym__(&V);
3538    globval.Elem_nFam++;
3539    if (globval.Elem_nFam <= Elem_nFamMax) {
3540      WITH = &ElemFam[globval.Elem_nFam-1];
3541      WITH1 = &WITH->ElemF;
3542      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3543      WITH1->PL = *V.rnum;
3544      WITH1->Pkind = PartsKind(Recombiner);
3545      Recombiner_Alloc(&WITH->ElemF);
3546    } else {
3547      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3548             globval.Elem_nFam, (long)Elem_nFamMax);
3549      exit_(1);
3550    }
3551    break;
3552
3553    /**************************************************************************
3554      Solenoid
3555    ***************************************************************************
3556
3557    <name>: Solenoid,
3558            L=<length>, ( [m] )
3559            BoBrho = <B/Brho [1/m]>,
3560            N =<# of kicks>,
3561            method=<method>
3562
3563    Example
3564
3565      B: solenoid, L=0.70, BoBrho=10.0;
3566
3567    **************************************************************************/
3568
3569  case solsym:
3570    getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3571    GetSym__(&V);
3572    QL = 0.0; /* L */
3573    QK = 0.0; /* K */
3574    k1 = 1;   /* N */
3575    P_addset(P_expset(mysys, 0), (long)lsym);
3576    P_addset(mysys, (long)bobrhosym);
3577    P_addset(mysys, (long)nsym);
3578    do { /* read L, K, N */
3579      test__(mysys, "illegal parameter", &V);
3580      sym1 = *V.sym;
3581      getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3582      switch (sym1) {
3583
3584      case lsym:
3585        QL = EVAL_(&V);
3586        break;
3587
3588      case bobrhosym:
3589        QK = EVAL_(&V);
3590        break;
3591
3592      case nsym:
3593        k1 = (long)floor(EVAL_(&V) + 0.5);
3594        break;
3595
3596      default:
3597        cout << "Solenoid: undef. case" << endl;
3598        exit_(1);
3599        break;
3600      }
3601      test__(P_expset(SET, (1 << ((long)comma)) | (1 << ((long)semicolon))),
3602             "<, > or <;> expected", &V);
3603      if (*V.sym == comma)
3604        GetSym__(&V);
3605    } while (P_inset(*V.sym, mysys));
3606    test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
3607    GetSym__(&V);
3608    globval.Elem_nFam++;
3609    if (globval.Elem_nFam <= Elem_nFamMax) {
3610      WITH = &ElemFam[globval.Elem_nFam-1];
3611      WITH1 = &WITH->ElemF;
3612      Solenoid_Alloc(&WITH->ElemF);
3613      WITH7 = WITH1->Sol;
3614      memcpy(WITH1->PName, ElementName, sizeof(partsName));
3615      WITH1->Pkind = Solenoid;
3616      WITH1->PL = QL; WITH7->N = k1; WITH7->BoBrho = QK;
3617    } else {
3618      printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3619             globval.Elem_nFam, (long)Elem_nFamMax);
3620      exit_(1);
3621    }
3622    break;
3623
3624    /**************************************************************************
3625      BLOCK DEFINITION
3626    **************************************************************************/
3627
3628  case ident:
3629  case intcon:
3630  case invsym:   /* Block Definition */
3631    ProcessBlockInput(&V);
3632    break;
3633  default:
3634    break;
3635  }/*3.5:of CASE*/
3636
3637  Result = true;
3638
3639 _L9999:
3640
3641  return Result;
3642}  /*of procedure Lat_DealElement*/
3643
3644
3645static void errorm___(const char *cmnt, struct LOC_Lattice_Read *LINK)
3646{
3647  /*write(fo, ' ****')*/
3648  /*error*/
3649  if (LINK->cc > LINK->errpos) {
3650    fprintf(*LINK->fo, "%*c^%.80s", (int)(LINK->cc - LINK->errpos),
3651            ' ', cmnt);
3652    LINK->errpos = LINK->cc + 3;
3653  }
3654  while (!P_eof(*LINK->fi))
3655    Lat_Nextch(LINK->fi, LINK->fo, &LINK->cc, &LINK->ll, &LINK->errpos,
3656               &LINK->lc, &LINK->chin, &LINK->skipflag, LINK->line, LINK);
3657  ErrFlag = true;
3658  longjmp(LINK->_JL9999, 1);
3659}
3660
3661
3662static void GetSym___(struct LOC_Lattice_Read *LINK)
3663{
3664  /* reads next symbol  */
3665  /*GetSym*/
3666  Lat_GetSym(LINK->fi, LINK->fo, &LINK->cc, &LINK->ll, &LINK->errpos,
3667             &LINK->lc, &LINK->nkw, &LINK->inum, (long)emax, (long)emin,
3668             (long)kmax, nmax, &LINK->chin, LINK->id, &LINK->rnum,
3669             &LINK->skipflag, &LINK->rsvwd, LINK->line, &LINK->sym, LINK->key,
3670             LINK->ksy, LINK->sps, LINK);
3671}
3672
3673
3674static void test___(long *s1, const char *cmnt, struct LOC_Lattice_Read *LINK)
3675{
3676  /*test*/
3677  if (!P_inset(LINK->sym, s1))
3678    errorm___(cmnt, LINK);
3679}
3680
3681
3682static void getest___(long *s1, const char *cmnt, struct LOC_Lattice_Read *LINK)
3683{
3684  /*test*/
3685  GetSym___(LINK);
3686  if (!P_inset(LINK->sym, s1))
3687    errorm___(cmnt, LINK);
3688}
3689
3690
3691/* Local variables for init_reserved_words: */
3692struct LOC_init_reserved_words
3693{
3694  struct LOC_Lattice_Read *LINK;
3695};
3696
3697
3698static void Reg(const char *name, Lat_symbol ks,
3699                struct LOC_init_reserved_words *LINK)
3700{
3701  LINK->LINK->nkw++;  /* incrementation of the number of keywords */
3702  if (LINK->LINK->nkw > Lat_nkw_max) {
3703    cout << "Reg: Lat_nkw_max exceeded " << LINK->LINK->nkw
3704         << "(" << Lat_nkw_max << ")" << endl;
3705  }
3706  memcpy(LINK->LINK->key[LINK->LINK->nkw - 1], name, sizeof(alfa_));
3707  LINK->LINK->ksy[LINK->LINK->nkw - 1] = ks;
3708}
3709
3710
3711static void init_reserved_words(struct LOC_Lattice_Read *LINK)
3712{
3713  struct LOC_init_reserved_words V;
3714
3715  V.LINK = LINK;
3716  LINK->nkw = 0; /* Number of keywords equals zero */
3717  /*-------------------------------------------------------------
3718  To define reserved symbol in the lattice reading,
3719  MUST follow alphabetical list !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3720  --------------------------------------------------------------*/
3721  Reg("and            ", andsym, &V);
3722  Reg("beam           ", bemsym, &V);
3723  Reg("bending        ", bndsym, &V);
3724  Reg("cavity         ", cavsym, &V);
3725  Reg("cell           ", celsym, &V);
3726  Reg("chromaticity   ", chmsym, &V);
3727  Reg("corrector      ", corsym, &V);  /* corrector */
3728  Reg("dbname         ", dbnsym, &V);
3729  Reg("define         ", defsym, &V);
3730  Reg("dispersion     ", dspsym, &V);
3731  Reg("drift          ", drfsym, &V);
3732  Reg("dt             ", dtsym, &V);
3733  Reg("edge_effect1   ", edge_effect1sym, &V);     /* Jianfeng Zhang*/
3734  Reg("edge_effect2   ", edge_effect2sym, &V);     /* Jianfeng Zhang */
3735  Reg("end            ", endsym, &V);
3736  Reg("ff1            ", ff1sym, &V);     /* Laurent */
3737  Reg("ff2            ", ff2sym, &V);     /* Laurent */
3738  Reg("ffscaling      ", ffscalingsym, &V);/* quadff scaling  J.Zhang */
3739  Reg("fieldmap       ", fmsym, &V);
3740  Reg("file1          ", fnamesym1, &V);   /* ID Laurent */
3741  Reg("file2          ", fnamesym2, &V);   /* ID Laurent */
3742  Reg("focusing       ", fcssym, &V);
3743  Reg("frequency      ", frqsym, &V);
3744  Reg("fringe         ", frgsym, &V);
3745  Reg("galilean       ", xytsym, &V);
3746  Reg("gap            ", gapsym, &V);
3747  Reg("ghost          ", gstsym, &V);
3748  Reg("h1             ", h1sym, &V);
3749  Reg("h2             ", h2sym, &V);
3750  Reg("harm           ", harmsym, &V);
3751  Reg("harnum         ", harnumsym, &V);
3752  Reg("hom            ", homsym, &V);
3753  Reg("horizontal     ", horsym, &V); /* with "corrector", define the horizontal corrector in the lattice*/
3754  Reg("insertion      ", idsym, &V);   /* ID Laurent */
3755  Reg("inv            ", invsym, &V);
3756  Reg("kick           ", corkicksym, &V); /* with "corrector", define the kick angle of the corrector ,  Jianfeng Zhang*/
3757  Reg("kicker         ", kicksym, &V);
3758  Reg("ks             ", kssym, &V);
3759  Reg("lambda         ", lmdsym, &V);
3760  Reg("lattice        ", latsym, &V);
3761  Reg("marker         ", mrksym, &V);
3762  Reg("matrix         ", matsym, &V);
3763  Reg("method         ", mthsym, &V);
3764  Reg("monitor        ", monsym, &V);
3765  Reg("multipole      ", mpsym, &V);
3766  Reg("nonlinear      ", nbdsym, &V);
3767  Reg("parameter      ", prmsym, &V);
3768  Reg("position       ", possym, &V);
3769  Reg("print          ", prnsym, &V);
3770  Reg("quadrupole     ", qdsym, &V);
3771  Reg("recombiner     ", recsym, &V);
3772  Reg("roll           ", rollsym, &V);
3773  Reg("scaling1       ", scalingsym1, &V); /* ID Laurent */
3774  Reg("scaling2       ", scalingsym2, &V); /* ID Laurent */
3775  Reg("sextupole      ", sexsym, &V);
3776  Reg("solenoid       ", solsym, &V);
3777  Reg("spreader       ", sprsym, &V);
3778  Reg("symmetry       ", symsym, &V);
3779  Reg("t1             ", t1sym, &V);
3780  Reg("t2             ", t2sym, &V);
3781  Reg("table          ", tblsym, &V);
3782  Reg("task           ", tsksym, &V);
3783  Reg("tilt           ", tiltsym, &V); // added for compatibility with Tracy II
3784  Reg("type           ", typsym, &V);
3785  Reg("use            ", usesym, &V);
3786  Reg("vertical       ", versym, &V); /* with "corrector", define the vertical corrector in the lattice*/
3787  Reg("voltage        ", vrfsym, &V);
3788  Reg("wiggler        ", wglsym, &V);
3789
3790  if (trace) fprintf(stdout,"Nb of keywords = %ld (%d)\n",
3791                     LINK->nkw, Lat_nkw_max);
3792
3793  LINK->sps[(int)'+'] = plus_;
3794  LINK->sps[(int)'-'] = minus_;
3795  LINK->sps[(int)'('] = lparent;
3796  LINK->sps[(int)')'] = rparent;
3797  LINK->sps[(int)'='] = eql;
3798  LINK->sps[(int)','] = comma;
3799  LINK->sps[(int)'['] = lbrack;
3800  LINK->sps[(int)']'] = rbrack;
3801  LINK->sps[(int)'\''] = squote;
3802  LINK->sps[(int)'&'] = andsy;
3803  LINK->sps[(int)';'] = semicolon;
3804  LINK->sps[(int)'/'] = rdiv;
3805  LINK->sps[(int)':'] = colon;
3806
3807  if (trace)
3808    printf("%d %d %d %d %d %d %d %d %d %d %d %d %d %d \n",
3809           (int)'+', (int)'-', (int)'(', (int)')', (int)'=',
3810           (int)',', (int)'[', (int)'[', (int)']', (int)'\'',
3811           (int)'&', (int)';', (int)'/', (int)':');
3812
3813  LINK->lc = 0;   /* reset line counter */
3814  LINK->ll = 0;   /* reset line length  */
3815  LINK->cc = 0;   /* reset char counter */
3816  LINK->errpos = 0;   /* reset error position */
3817  LINK->chin = ' ';   /* reset current char   */
3818  LINK->skipflag = false;   /* reset skip flag  */
3819  P_addset(P_expset(LINK->defbegsys, 0), (long)ident);
3820  P_addset(P_expset(LINK->elmbegsys, 0), (long)qdsym);
3821  P_addset(LINK->elmbegsys, (long)sexsym); /*link the lattice element name*/
3822  P_addset(LINK->elmbegsys, (long)corsym);
3823  P_addset(LINK->elmbegsys, (long)bemsym);
3824  P_addset(LINK->elmbegsys, (long)gstsym);
3825  P_addset(LINK->elmbegsys, (long)mrksym);
3826  P_addset(LINK->elmbegsys, (long)nbdsym);
3827  P_addset(LINK->elmbegsys, (long)frgsym);
3828  P_addset(LINK->elmbegsys, (long)xytsym);
3829  P_addset(LINK->elmbegsys, (long)drfsym);
3830  P_addset(LINK->elmbegsys, (long)bndsym);
3831  P_addset(LINK->elmbegsys, (long)wglsym);
3832  P_addset(LINK->elmbegsys, (long)mpsym);
3833  P_addset(LINK->elmbegsys, (long)cavsym);
3834  P_addset(LINK->elmbegsys, (long)idsym);      /* ID Laurent */
3835  P_addset(LINK->elmbegsys, (long)fmsym);
3836  P_addset(LINK->elmbegsys, (long)sprsym);
3837  P_addset(LINK->elmbegsys, (long)recsym);
3838  P_addset(LINK->elmbegsys, (long)solsym);
3839  P_addset(LINK->elmbegsys, (long)fnamesym1);  /* ID file name Laurent */
3840  P_addset(LINK->elmbegsys, (long)fnamesym2);  /* ID file name Laurent */
3841//  P_addset(LINK->elmbegsys, (long)scalingsym); /* ID scale factor Laurent */
3842}
3843
3844/* Local variables for DealWithDefns: */
3845struct LOC_DealWithDefns
3846{
3847  struct LOC_Lattice_Read *LINK;
3848};
3849
3850static double EVAL__(struct LOC_DealWithDefns *LINK)
3851{
3852  return (Lat_EVAL(LINK->LINK->fi, LINK->LINK->fo, &LINK->LINK->cc,
3853                   &LINK->LINK->ll, &LINK->LINK->errpos, &LINK->LINK->lc,
3854                   &LINK->LINK->nkw, &LINK->LINK->inum, (long)emax,
3855                   (long)emin, (long)kmax, nmax, &LINK->LINK->chin,
3856                   LINK->LINK->id, &LINK->LINK->rnum, &LINK->LINK->skipflag,
3857                   &LINK->LINK->rsvwd, LINK->LINK->line, &LINK->LINK->sym,
3858                   LINK->LINK->key, LINK->LINK->ksy, LINK->LINK->sps,
3859                   LINK->LINK));
3860}
3861
3862
3863/******************************************************
3864 *                                                   *
3865 *                  P A R S E R                      *
3866 *                                                   *
3867 ******************************************************/
3868
3869static void DealWithDefns(struct LOC_Lattice_Read *LINK)
3870{  /*0*/
3871  struct LOC_DealWithDefns V;
3872  partsName idsave, ElementName, BlockName, IdentName;
3873  long i, j, k, k1;
3874  symset SET;
3875  long SET1[(long)ident / 32 + 2];
3876  long SET2[(long)period_ / 32 + 2];
3877  long SET3[(long)invsym / 32 + 2];
3878  _REC_BlockStype *WITH;
3879  long FORLIM;
3880  long SET4[(long)symsym / 32 + 2];
3881  long SET5[(long)endsym / 32 + 2];
3882
3883  /************** DEAL WITH DEFINITIONS *********************************/
3884
3885  V.LINK = LINK;
3886  GetSym___(LINK);
3887  if (LINK->sym != latsym) {  /*1*/
3888    test___(P_expset(SET, 0), "<illegal operand> detected", LINK);
3889    return;
3890  }
3891  /****** The first word must be 'lattice' **********/
3892  getest___(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", LINK);
3893  // Test whether expression exists
3894  getest___(P_addset(P_expset(SET1, 0), (long)ident),
3895            "<identifier> expected", LINK);
3896
3897  /***************************************************************************/
3898  if (LINK->sym == ident) {
3899    do {   /*2*/
3900      if (LINK->sym == ident) {  /*2.5:-----------------------*/
3901        memcpy(idsave, LINK->id, sizeof(alfa_));
3902        memset(idsave + sizeof(alfa_), ' ', sizeof(partsName) - sizeof(alfa_));
3903        memcpy(ElementName, LINK->id, sizeof(alfa_));
3904        memset(ElementName + sizeof(alfa_), ' ',
3905               sizeof(partsName) - sizeof(alfa_));
3906        memcpy(BlockName, LINK->id, sizeof(alfa_));
3907        memset(BlockName + sizeof(alfa_), ' ',
3908               sizeof(partsName) - sizeof(alfa_));
3909        P_addset(P_expset(SET2, 0), (long)colon);
3910        P_addset(SET2, (long)eql);
3911        getest___(P_addset(SET2, (long)period_),
3912                  "<colon>, <=> or <.> expected", LINK);
3913        if (LINK->sym == colon)   /*3:of IF sym=colon*/ {  /*3*/
3914          P_addset(P_expset(SET3, 0), (long)ident);
3915          P_addset(SET3, (long)intcon);
3916          getest___(P_setunion(SET, LINK->elmbegsys,
3917                               P_addset(SET3, (long)invsym)),
3918                    "<identifier>, <integer> or <INV> expected", LINK);
3919          P_addset(P_expset(SET3, 0), (long)ident);
3920          P_addset(SET3, (long)intcon);
3921          if (P_inset(LINK->sym,
3922                      P_setunion(SET, LINK->elmbegsys,
3923                                 P_addset(SET3, (long)invsym)))) {
3924            if (!Lat_DealElement(LINK->fi, LINK->fo, &LINK->cc,
3925                                 &LINK->ll,
3926                                 &LINK->errpos, &LINK->lc, &LINK->nkw,
3927                                 &LINK->inum, (long)emax, (long)emin,
3928                                 (long)kmax, nmax, &LINK->chin,
3929                                 LINK->id,
3930                                 ElementName, BlockName, &LINK->rnum,
3931                                 &LINK->skipflag, &LINK->rsvwd,
3932                                 LINK->line,
3933                                 &LINK->sym, LINK->key, LINK->ksy,
3934                                 LINK->sps, LINK))
3935              longjmp(LINK->_JL9999, 1);
3936          }
3937                 
3938        } else {
3939          /**************************************************************
3940           *                                                           *
3941           *         P A R A M E T E R  A S S I G N M E N T            *
3942           *                                                           *
3943           **************************************************************/
3944
3945          if (LINK->sym == eql) {  /*3:of parameter*/
3946            memcpy(IdentName, idsave, sizeof(partsName));
3947            i = CheckUDItable(IdentName, LINK);
3948            if (i == 0)
3949              EnterUDItable(IdentName, EVAL__(&V), LINK);
3950            else
3951              ModUDItable(i, EVAL__(&V), LINK);
3952            test___(P_expset(SET, 1 << ((long)semicolon)),
3953                    "<;> expected", LINK);
3954            GetSym___(LINK);
3955            /*3:of parameter*/
3956            /*-----
3957              IdentName:=idsave;
3958              i:=CheckElementtable(IdentName);
3959              IF i=0 THEN Test([], '<element name> expected');
3960              getest([lsym, tsym, t1sym, t2sym, gapsym, ksym],
3961                     'illegal component');
3962              sym1:=sym;
3963              getest([eql], '<=> expected');
3964              case sym1 of
3965              lsym:  ElemFam[i].ElemF.PL :=Eval;
3966              ksym:  ElemFam[i].ElemF.Pk :=Eval;
3967              tsym:  ElemFam[i].ElemF.Pt :=Eval;
3968              t1sym: ElemFam[i].ElemF.Pt1:=Eval;
3969              t2sym: ElemFam[i].ElemF.Pt2:=Eval;
3970              gapsym: ElemFam[i].ElemF.Pgap:=Eval;
3971              END;
3972              test([semicolon], '<;> expected');
3973              GetSym;
3974              -----*/
3975            /*3:of parameter */
3976          }  /*3:of parameter */
3977        }
3978
3979        /*****************************
3980         *                           *
3981         *     DEAL WITH ELEMENT     *
3982         *                           *
3983         *****************************/
3984
3985      }  /*2.5*/
3986
3987      /**************************************************************
3988       *                                                           *
3989       *         C E L L    D E F I N I T I O N                    *
3990       *                                                           *
3991       *************************************************************
3992
3993       CELL : <block name>, SYMMETRY=<symmetry>;
3994
3995              <block name>:== name of a block.
3996              <symmetry>:== number of supersymmetry:== number of the block/ring
3997
3998       Example
3999
4000         CELL : BL1, Symmetry=12;
4001
4002      ************************************************************************/
4003
4004      if (LINK->sym == celsym) {  /*3*/
4005        getest___(P_expset(SET, 1 << ((long)colon)),
4006                  "<colon> expected", LINK);
4007        getest___(P_addset(P_expset(SET1, 0), (long)ident),
4008                  "<Block name> expected", LINK);
4009        i = CheckBLOCKStable(LINK->id, LINK);
4010        if (i == 0)
4011          test___(P_expset(SET, 0),
4012                  "<Block name> expected", LINK);
4013        k = 0;
4014        if (i != 0) {  /*4*/
4015          WITH = &LINK->BlockS[i - 1];
4016          FORLIM = WITH->BOWARI;
4017          for (j = WITH->BSTART - 1; j < FORLIM; j++) {  /*6*/
4018            k++;
4019            if (j < NoBEmax)
4020              k1 = LINK->Bstack[j];
4021            else {
4022              printf("** DealWithDefns: NoBEmax exceeded %ld (%d)\n",
4023                     j+1, NoBEmax);
4024              exit(1);
4025            }
4026            if (k <= Cell_nLocMax)
4027              Cell[k].Fnum = k1;
4028            else {
4029              printf("** Cell_nLocMax exhausted: %ld(%ld)\n",
4030                     k, (long)Cell_nLocMax);
4031              exit_(1);
4032            }
4033          }
4034          /*5*/
4035        }
4036        /*4*/
4037        if (k <= Cell_nLocMax)
4038          globval.Cell_nLoc = k;   /*number of Elements in a cell*/
4039        else {
4040          printf("** Cell_nLocMax exhausted: %ld(%ld)\n",
4041                 k, (long)Cell_nLocMax);
4042          exit_(1);
4043        }
4044        getest___(P_expset(SET, 1 << ((long)comma)),
4045                  "<, > expected", LINK);
4046        getest___(P_addset(P_expset(SET4, 0), (long)symsym),
4047                  "<symmetry> expected", LINK);
4048        getest___(P_expset(SET, 1 << ((long)eql)),
4049                  "<=> expected", LINK);
4050        LINK->Symmetry = (long)floor(EVAL__(&V) + 0.5);
4051        if (LINK->Symmetry >= 1)
4052          LINK->Ring = true;
4053        else {
4054          LINK->Symmetry = 1;
4055          LINK->Ring = false;
4056        }
4057        test___(P_expset(SET, 1 << ((long)semicolon)),
4058                "<;> expected", LINK);
4059        GetSym___(LINK);
4060      }  /*3: of celsym*/
4061
4062
4063      switch (LINK->sym) {   /*2*/
4064
4065        /******************************************
4066
4067                     PRINT element-name
4068                     PRINT block_name
4069                     PRINT parameter
4070
4071        ******************************************/
4072
4073      case prnsym:  /*4*/
4074        getest___(P_addset(P_expset(SET1, 0), (long)ident),
4075                  "<identifiler> expected", LINK);
4076        memcpy(IdentName, LINK->id, sizeof(alfa_));
4077        memset(IdentName + sizeof(alfa_), ' ',
4078               sizeof(partsName) - sizeof(alfa_));
4079        i = CheckElementtable(IdentName, LINK);
4080        if (i == 0) {   /*PrintElementParam(i)*/
4081          i = CheckBLOCKStable(IdentName, LINK);
4082          if (i == 0) {   /*PrintBlockParam(i)*/
4083            i = CheckUDItable(IdentName, LINK);
4084            if (i == 0)
4085              getest___(P_expset(SET, 0),
4086                        " invalid expression", LINK);
4087            /*PrintUDIParam(i)*/
4088          }
4089        }
4090        if (i != 0) {
4091          getest___(P_expset(SET, 1 << ((long)semicolon)),
4092                    "<;> expected", LINK);
4093          GetSym___(LINK);
4094        }
4095        break;
4096        /*4*/
4097      default:
4098        break;
4099      }/*3:of CASE*/
4100
4101    } while (LINK->sym == (long)prnsym || LINK->sym == (long)celsym ||
4102             LINK->sym == (long)dspsym ||
4103             LINK->sym == (long)chmsym || LINK->sym == (long)ident);
4104  }
4105
4106  test___(P_addset(P_expset(SET5, 0), (long)endsym), "<END> expected", LINK);
4107  getest___(P_expset(SET, 1 << ((long)semicolon)), "<;> expexted", LINK);
4108
4109
4110
4111  /*8888888888*/
4112  /*5*/
4113  /*6*/
4114  /*6*/
4115  /*5*/
4116  /*1*/
4117  /*1*/
4118}  /*0*/
4119
4120
4121void GetEnergy(struct LOC_Lattice_Read *LINK)
4122{
4123  long k;
4124
4125  k = CheckUDItable("energy         ", LINK);
4126  if (k == 0) {
4127    printf("> Beam energy is not defined.\n");
4128    printf("  Input beam energy in [GeV] := ");
4129    scanf("%lg%*[^\n]", &globval.Energy);
4130    getchar();
4131    EnterUDItable("energy         ", globval.Energy, LINK);
4132  } else
4133    RefUDItable("energy         ", &globval.Energy, LINK);
4134}
4135
4136
4137void GetRingType(struct LOC_Lattice_Read *LINK)
4138{
4139  long k;
4140
4141  k = CheckUDItable("ringtype       ", LINK);
4142  if (k == 0L) {
4143    fprintf(stdout,"> Ring type is not defined, default is ring.\n");
4144    globval.RingType = 1;
4145  } else {
4146    globval.RingType = (int) LINK->UDItable[k - 1L].Uvalue;
4147    if (globval.RingType != 1 && globval.RingType != 0) {
4148      printf("> ringtype variable is not defined"
4149              " properly in the lattice file\n");
4150      printf("> ringtype set to 1 means ring\n");
4151      printf("> ringtype set to 0 means transfer line\n");
4152      exit_(1);
4153    }
4154  }
4155}
4156
4157
4158/****************************************************************************/
4159/* void GetDP(struct LOC_Lattice_Read *LINK)
4160
4161   Purpose:
4162       Define particle energy offset read from lattice file
4163
4164   Input:
4165       none
4166
4167   Output:
4168       none
4169
4170   Return:
4171       none
4172
4173   Global variables:
4174       none
4175
4176   Specific functions:
4177       none
4178
4179   Comments:
4180       none
4181
4182****************************************************************************/
4183static void GetDP(struct LOC_Lattice_Read *LINK)
4184{
4185  long k;
4186
4187  k = CheckUDItable("dp             ", LINK);
4188  if (k != 0) {
4189      RefUDItable("dp             ", &globval.dPcommon, LINK);
4190      return;
4191    }
4192  printf("> dP/P is not defined.\n");
4193  printf("  Input dP/P := ");
4194  scanf("%lg%*[^\n]", &globval.dPcommon);
4195  getchar();
4196  EnterUDItable("dp             ", globval.dPcommon, LINK);
4197}
4198
4199/****************************************************************************/
4200/* void GetCODEPS(LOC_Lattice_Read *LINK)
4201
4202   Purpose:
4203       Read and assign cod precision read from lattice file
4204
4205   Input:
4206       none
4207
4208   Output:
4209       none
4210
4211   Return:
4212       none
4213
4214   Global variables:
4215       none
4216
4217   Specific functions:
4218       none
4219
4220   Comments:
4221       none
4222
4223****************************************************************************/
4224static void GetCODEPS(struct LOC_Lattice_Read *LINK)
4225{
4226  long k;
4227
4228  k = CheckUDItable("codeps         ", LINK);
4229  if (k != 0) {
4230    RefUDItable("codeps         ", &globval.CODeps, LINK);
4231    return;
4232  }
4233  printf("> CODEPS is not defined.\n");
4234  printf("  Input CODEPS := ");
4235  scanf("%lg%*[^\n]", &globval.CODeps);
4236  getchar();
4237  EnterUDItable("codeps         ", globval.Energy, LINK);
4238}
4239
4240/****************************************************************************/
4241/* Local double Circumference(struct LOC_Lattice_Read *LINK)
4242
4243   Purpose:
4244
4245
4246   Input:
4247       none
4248
4249   Output:
4250       none
4251
4252   Return:
4253       none
4254
4255   Global variables:
4256       none
4257
4258   Specific functions:
4259       none
4260
4261   Comments:
4262       none
4263
4264****************************************************************************/
4265static double Circumference(struct LOC_Lattice_Read *LINK)
4266{
4267  long i;
4268  double S;
4269  long FORLIM;
4270
4271  S = 0.0;
4272  FORLIM = globval.Cell_nLoc;
4273  for (i = 1; i <= FORLIM; i++)
4274    S += ElemFam[Cell[i].Fnum - 1].ElemF.PL;
4275  return S;
4276}
4277
4278
4279/****************************************************************************/
4280/* Local void RegisterKids(struct LOC_Lattice_Read *LINK)
4281
4282   Purpose:
4283
4284
4285   Input:
4286       none
4287
4288   Output:
4289       none
4290
4291   Return:
4292       none
4293
4294   Global variables:
4295       none
4296
4297   Specific functions:
4298       none
4299
4300   Comments:
4301       none
4302 ****************************************************************************/
4303
4304static void RegisterKids(struct LOC_Lattice_Read *LINK)
4305{
4306  long i, FORLIM;
4307  ElemFamType *WITH;
4308
4309  if (globval.Elem_nFam <= Elem_nFamMax) {
4310    FORLIM = globval.Elem_nFam;
4311    for (i = 0; i < FORLIM; i++)
4312      ElemFam[i].nKid = 0;
4313  } else {
4314    printf("Elem_nFamMax exceeded: %ld(%d)\n",
4315           globval.Elem_nFam, Elem_nFamMax);
4316    exit_(1);
4317  }
4318
4319  FORLIM = globval.Cell_nLoc;
4320  for (i = 1; i <= FORLIM; i++) {
4321    WITH = &ElemFam[Cell[i].Fnum - 1];
4322    WITH->nKid++;
4323    if (WITH->nKid <= nKidMax) {
4324      WITH->KidList[WITH->nKid - 1] = i;
4325      Cell[i].Knum = WITH->nKid;
4326    } else
4327      printf("nKidMax exceeded: %d(%d)\n", WITH->nKid, nKidMax);
4328  }
4329}
4330
4331
4332/****************************************************************************/
4333/* void PrintResult(struct LOC_Lattice_Read *LINK)
4334
4335   Purpose:
4336       Print Lattice statistics
4337
4338   input:
4339       LINK
4340
4341   output:
4342       none
4343
4344   return:
4345       none
4346
4347   global variables:
4348       none
4349
4350   specific functions:
4351       none
4352
4353   comments
4354       none
4355
4356****************************************************************************/
4357void PrintResult(struct LOC_Lattice_Read *LINK)
4358{
4359  long j, nKid, FORLIM;
4360  struct tm *newtime;
4361
4362  /* Get time and date */
4363  newtime = GetTime();
4364
4365  printf("\n");
4366  printf("  TRACY III v. 3.5 compiled on %s\n",__DATE__);
4367  printf("\n");
4368  printf("  LATTICE Statistics for today %s \n\n", asctime2(newtime));
4369  printf("  Number of constants: UDIC                 =%5ld"
4370         ", UDImax          =%5d\n",
4371         LINK->UDIC, UDImax);
4372  printf("  Number of keywords : nkw                  =%5ld"
4373         ", Lat_nkw_max     =%5d\n",
4374         LINK->nkw, Lat_nkw_max);
4375  printf("  Number of Families : globval.Elem_nFam    =%5ld"
4376         ", Elem_nFamMax    =%5d\n",
4377         globval.Elem_nFam, Elem_nFamMax);
4378  nKid = 0L;
4379  FORLIM = globval.Elem_nFam;
4380  for (j = 0L; j < FORLIM; j++) {
4381    if (ElemFam[j].nKid > nKid)
4382      nKid = ElemFam[j].nKid;
4383  }
4384  printf("  Max number of Kids : nKidMax              =%5ld"
4385         ", nKidMax         =%5d\n",
4386         nKid, nKidMax);
4387  printf("  Number of Blocks   : NoB                  =%5ld"
4388         ", NoBmax          =%5d\n",
4389         LINK->NoB, NoBmax);
4390  printf("  Max Block size     : NoBE                 =%5ld"
4391         ", NoBEmax         =%5d\n",
4392         LINK->Bpointer, NoBEmax);
4393  printf("  Number of Elements : globval.Cell_nLoc    =%5ld"
4394         ", Cell_nLocmax    =%5d\n",
4395         globval.Cell_nLoc, Cell_nLocMax);
4396  printf("  Circumference      : %12.7f [m]\n", Circumference(LINK));
4397  printf("\n");
4398  printf("\n");
4399}
4400
4401/****************************************************************************/
4402/* long ElemIndex(const char *name)
4403
4404   Purpose:
4405       return family index of the element .
4406       Note: in the PASCAL version the element family index could be
4407       comfortably accessed using the element name.
4408       This is no longer possible because we gave up on the interpretive PASCAL-S.
4409   Input:
4410       name    Family name
4411
4412   Output:
4413       none
4414
4415   Return:
4416       none
4417
4418   Global variables:
4419       none
4420
4421   Specific functions:
4422       none
4423
4424   Comments:
4425       30-06-2011   Fix the bug to get the correct Cell[i].Elem.PName.
4426****************************************************************************/
4427
4428long ElemIndex(const char *name)
4429{
4430  long       i = 0;
4431  int        n = 0;
4432  partsName  name1, name2;
4433
4434 
4435  const bool  prt = false;
4436
4437  if (prt) printf("\n");
4438
4439while(name[i]!= ' ' && name[i]!= '\0'){
4440  name1[i] = tolower(name[i]);
4441  i++;
4442  }
4443name1[i] = '\0'; 
4444
4445
4446  if (globval.Elem_nFam > Elem_nFamMax) {
4447    printf("ElemIndex: Elem_nFamMax exceeded: %ld(%d)\n",
4448           globval.Elem_nFam, Elem_nFamMax);
4449    exit_(1);
4450  }
4451
4452  for (i = 1; i <= globval.Elem_nFam; i++) 
4453  {
4454    n = 0;
4455    while ((ElemFam[i-1].ElemF.PName[n] != ' ') && (ElemFam[i-1].ElemF.PName[n] != '\0')) 
4456    {
4457      name2[n] = ElemFam[i-1].ElemF.PName[n]; 
4458      n++;
4459    }
4460    name2[n] = '\0';
4461
4462    if (prt)
4463      printf("%d %d %s |%s|%s|\n",
4464             n, strcmp(name2, name1) == 0, name1, ElemFam[i-1].ElemF.PName, name2);
4465    if (strcmp(name2, name1) == 0) 
4466      return i;
4467  }
4468
4469  printf("ElemIndex: undefined element %s\n", name);
4470  exit_(1);
4471  return 0;
4472}
4473
4474/****************************************************************************/
4475/* boolean Lattice_Read(FILE **fi_, FILE **fo_)
4476
4477   Purpose:
4478       Low level routine for reading lattice file
4479
4480   Input:
4481       none
4482
4483   Output:
4484       none
4485
4486   Return:
4487       none
4488
4489   Global variables:
4490       globval
4491
4492   Specific functions:
4493       setjmp f2c
4494       init_reserved_words
4495
4496   Comments:
4497       none
4498
4499****************************************************************************/
4500
4501bool Lattice_Read(FILE **fi_, FILE **fo_)
4502{
4503  struct LOC_Lattice_Read V;
4504
4505  if (trace)
4506    printf("t2lat: dndsym = %d, solsym = %d, max_set = %d, SETBITS = %u\n",
4507           bndsym, solsym, max_set, (unsigned)(4*sizeof(long int)));
4508
4509  V.fi = fi_; /* input lattice file */
4510  V.fo = fo_; /* output lattice file */
4511  if (setjmp(V._JL9999))
4512    goto _L9999;
4513  V.UDIC = 0; 
4514  globval.Cell_nLoc = 0; 
4515  globval.Elem_nFam = 0; 
4516  V.NoB = 0;
4517  V.Symmetry = 0; 
4518  V.Bpointer = 0;
4519
4520  globval.CODeps   = 0.0; 
4521  globval.dPcommon = 0.0; 
4522  globval.Energy   = 0.0;
4523
4524  ErrFlag = false;
4525
4526  init_reserved_words(&V);
4527
4528  GetSym___(&V);
4529
4530  if (V.sym == defsym) 
4531  DealWithDefns(&V);
4532
4533  if (V.Symmetry != 0) 
4534  {
4535    GetRingType(&V);/* define whether a ring or a transfer line */
4536    GetEnergy(&V);  /* define particle energy */
4537    GetCODEPS(&V);  /* define COD precision */
4538    GetDP(&V);      /* define energy offset */
4539  }
4540
4541  if (*V.fi != NULL)
4542    fclose(*V.fi);  /* Close lat file */
4543  *V.fi = NULL;
4544  if (*V.fo != NULL)
4545    fclose(*V.fo);  /* Close lax file */
4546  *V.fo = NULL;
4547  RegisterKids(&V); /* Check whether too many elements */
4548  PrintResult(&V);  /* Print lattice statistics */
4549 _L9999:
4550  return (!ErrFlag);
4551}
4552
4553#undef NoBmax
4554#undef NoBEmax
4555#undef UDImax
4556#undef LatLLng
4557#undef Lat_nkw_max
4558#undef emax
4559#undef emin
4560#undef kmax
4561#undef nmax
4562
4563#undef nn              // added by nsrl-ii
4564#undef tmax            // added by nsrl-ii
4565
4566#undef smax
4567#undef xmax
4568
Note: See TracBrowser for help on using the repository browser.