Context Navigation

t2lat.cc @ 32

Last change on this file since 32 was 32, checked in by zhangj, 10 years ago
active the transport of the twiss functions and orbits of the transfer line.
Property svn:executable set to ``*
File size: 124.1 KB

Line
1	/* Tracy-2
2
3	J. Bengtsson, CBP, LBL 1990 - 1994 Pascal version
4	SLS, PSI 1995 - 1997
5	M. Boege SLS, PSI 1998 C translation
6	L. Nadolski SOLEIL 2002 Link to NAFF, Radia field maps
7	J. 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 /28 - 1/
36
37	typedef char Latlinetype[LatLLng];
38
39	typedef 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
70	const int max_set = (solsym-bndsym+1)/SETBITS + 2;
71
72	// array for set
73	typedef long int symset[max_set];
74
75	typedef alfa_ Lat_keytype[Lat_nkw_max];
76	typedef Lat_symbol Lat_ksytype[Lat_nkw_max];
77	typedef Lat_symbol Lat_spstype[256];
78
79	typedef struct _REC_BlockStype
80	{
81	partsName Bname; /* name of a beam line */
82	long BSTART, BOWARI;
83	} _REC_BlockStype;
84
85	typedef _REC_BlockStype BlockStype[NoBmax];
86
87	typedef long index_;
88
89	typedef enum {
90	notyp, ints, reals, bools, chars, arrays, records
91	} types;
92
93	typedef long typset;
94
95	typedef struct _REC_UDItable {
96	partsName Uname;
97	double Uvalue;
98	} _REC_UDItable;
99
100
101	//* Local variables for Lattice_Read: */
102	struct 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
142	int 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]
154	long 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
178	long 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
190	long 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
208	static 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
231	static 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
258	static long CheckUDItable(const char name, struct LOC_Lattice_Read LINK)
259	{
260	long i=0, j=0, FORLIM=0;
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
277	static 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
293	static 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
302	static 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
360	static 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
374	static 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
386	static 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
398	static 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
458	static 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: */
475	struct 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
488	static 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
495	static 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
524	static 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
558	static 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: */
857	struct 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
878	static void Expression(struct LOC_Lat_EVAL *LINK);
879
880
881	static 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
892	static 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
898	static 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
905	static 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
913	static 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
926	static 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
939	static void writes(struct LOC_Lat_EVAL *LINK)
940	{
941	/writeln('PUSH: s[', t:3, ']=', s[t]);/
942	}
943
944
945	static 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
958	static 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: */
974	struct LOC_Expression
975	{
976	struct LOC_Lat_EVAL *LINK;
977	};
978
979	/* Local variables for Term: */
980	struct LOC_Term
981	{
982	struct LOC_Expression *LINK;
983	};
984
985	/* Local variables for Factor: */
986	struct LOC_Factor
987	{
988	struct LOC_Term *LINK;
989	long i;
990	};
991
992
993	static 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
1016	static 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
1184	static 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
1213	static 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
1257	static 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: */
1320	struct 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
1336	static void GetBlock(struct LOC_Lat_ProcessBlockInput *LINK);
1337
1338
1339	static 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
1346	static 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
1356	static 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
1364	static 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
1374	double 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
1384	static 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: */
1407	struct LOC_GetBlock
1408	{
1409	struct LOC_Lat_ProcessBlockInput *LINK;
1410	};
1411
1412
1413	static 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
1446	static 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
1481	static 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
1643	static 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
1703	static 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: */
1728	struct 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
1754	static 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
1761	static 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
1770	static 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
1778	static 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
1787	static 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
1796	static 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
1807	static 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
1813	static 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
1837	static 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
1849	static 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	**********************/
1866	static 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
1896	static 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
1912	static 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
1944	static 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
1977	static 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	*************************************************************************/
2015	static 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 = 1; /* 1 is horizontal corrector, -1 is vertical corrector */
2655	k1 = 1; /* N, cut piece of corrector */
2656	k2 = Meth_Linear; /* integartion method */
2657	dt = 0.0; /* roll angle of the corrector */
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, kick angle, cut piece, integartion method, roll angle, 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	else{
2717	cout << "t2lat: Error! Must specify the type of the corrector, Horizontal or vertical!" << endl;
2718	exit_(1);
2719	}
2720	GetSym__(&V);
2721	}
2722	test__(P_expset(SET,
2723	(1 << ((long)comma)) \| (1 << ((long)semicolon))),
2724	"<, > or <;> expected", &V);
2725	if (*V.sym == comma)
2726	GetSym__(&V);
2727	} while (P_inset(V.sym, mysys)); /5*/
2728
2729	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
2730	}
2731	GetSym__(&V);
2732	globval.Elem_nFam++;
2733	if (globval.Elem_nFam <= Elem_nFamMax) {
2734	WITH = &ElemFam[globval.Elem_nFam-1];
2735	WITH1 = &WITH->ElemF;
2736	memcpy(WITH1->PName, ElementName, sizeof(partsName));
2737	WITH1->PL = QL;
2738	WITH1->Pkind = Mpole;
2739	Mpole_Alloc(&WITH->ElemF);
2740	WITH2 = WITH1->M;
2741	SetDBN(&V);
2742	if (WITH1->PL != 0.0)
2743	WITH2->Pthick = pthicktype(thick);
2744	else
2745	WITH2->Pthick = pthicktype(thin);
2746	WITH2->Pmethod = k2;
2747	WITH2->PN = k1;
2748	WITH2->PdTpar = dt;
2749	WITH2->PBpar[KplaneDip + HOMmax] = -1QKick; //assign the kick angle [rad]
2750
2751
2752
2753	} else {
2754	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2755	globval.Elem_nFam, (long)Elem_nFamMax);
2756	exit_(1);
2757	}
2758	break;
2759
2760	/**************************************************************************
2761	Beam Position Monitor
2762	***************************************************************************
2763
2764	<name>: Beam Position Monitor;
2765
2766	<name>:== Alphanumeric string. Up to NameLength character length.
2767	BEGIN with an alphabet.
2768
2769	Example
2770
2771	BPM: Beam Position Monitor;
2772
2773	**************************************************************************/
2774
2775	case bemsym:
2776	ClearHOMandDBN(&V);
2777	getest__(P_addset(P_expset(SET3, 0), (long)possym),
2778	"<position> expected", &V);
2779	getest__(P_expset(SET, 1 << ((long)monsym)), "<monitor> expected", &V);
2780	getest__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
2781	"<, > or <;> expected", &V);
2782	if (*V.sym == comma) {
2783	getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
2784	"illegal parameter", &V);
2785	sym1 = *V.sym;
2786	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2787	if (sym1 == dbnsym)
2788	GetDBN_(&V);
2789	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
2790	}
2791	GetSym__(&V);
2792	globval.Elem_nFam++;
2793	if (globval.Elem_nFam <= Elem_nFamMax) {
2794	WITH = &ElemFam[globval.Elem_nFam-1];
2795	WITH1 = &WITH->ElemF;
2796	memcpy(WITH1->PName, ElementName, sizeof(partsName));
2797	WITH1->Pkind = Mpole;
2798	Mpole_Alloc(&WITH->ElemF);
2799	WITH2 = WITH1->M;
2800	WITH2->Pthick = pthicktype(thin);
2801	SetDBN(&V);
2802	} else {
2803	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2804	globval.Elem_nFam, (long)Elem_nFamMax);
2805	exit_(1);
2806	}
2807	break;
2808
2809
2810	/**************************************************************************
2811	Marker
2812	***************************************************************************
2813
2814	<name>: Marker;
2815
2816	<name>:== Alphanumeric string. Up to NameLength character length.
2817	BEGIN with an alphabet.
2818
2819	Example
2820
2821	SYM: Marker;
2822
2823	**************************************************************************/
2824
2825	case mrksym:
2826	ClearHOMandDBN(&V);
2827	getest__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
2828	"<, > or <;> expected", &V);
2829	if (*V.sym == comma) {
2830	getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
2831	"illegal parameter", &V);
2832	sym1 = *V.sym;
2833	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2834	if (sym1 == dbnsym)
2835	GetDBN_(&V);
2836	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
2837	}
2838	GetSym__(&V);
2839	globval.Elem_nFam++;
2840	if (globval.Elem_nFam <= Elem_nFamMax) {
2841	WITH = &ElemFam[globval.Elem_nFam-1];
2842	WITH1 = &WITH->ElemF;
2843	memcpy(WITH1->PName, ElementName, sizeof(partsName));
2844	WITH1->PL = 0.0;
2845	WITH1->Pkind = PartsKind(marker);
2846	SetDBN(&V);
2847	} else {
2848	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
2849	globval.Elem_nFam, (long)Elem_nFamMax);
2850	exit_(1);
2851	}
2852	break;
2853
2854
2855	/**************************************************************************
2856	Ghost
2857	***************************************************************************
2858
2859	<name>: Ghost;
2860
2861	<name>:== Alphanumeric string. Up to NameLength character length.
2862	BEGIN with an alphabet.
2863
2864	Example
2865
2866	OBAKE : Ghost;
2867
2868	**************************************************************************/
2869	/*----------->>>
2870	GstSym:BEGIN
2871	getest([comma], '<, > expexted');
2872	getest([typsym], '<type> expected');
2873	getest([eql], '<=> expected');
2874	QL:=Eval;
2875	test([semicolon], '<;> expected');
2876	getsym;
2877	if sym=DBNsym then GetDBN;
2878	globval.Elem_nFam := globval.Elem_nFam + 1;
2879	if globval.Elem_nFam <= Elem_nFamMax then
2880	begin
2881	with ElemFam[globval.Elem_nFam].ElemF do
2882	with ElementT[globval.Elem_nFam] do
2883	BEGIN
2884	Pname:=ElementName; Pkind:=Ghost; PN:=round(QL);
2885	SetDBN;
2886	END;
2887	end
2888	else
2889	writeln('Elem_nFamMax exceeded: ', globval.Elem_nFam:1,
2890	'(', Elem_nFamMax:1, ')');
2891	END;
2892	<<-----------------------------*/
2893
2894
2895	/**************************************************************************
2896	Multipole
2897	***************************************************************************
2898
2899	<name>: Multipole,
2900	L=<length>, ( [m] )
2901	T =<bending angle>, ( [degree] )
2902	T1=<entrance angle>, ( [degree] )
2903	T2=<exit angle>, ( [degree] )
2904	Roll=<roll angle>, ( [deg], design roll angle )
2905	N =<# of kicks>,
2906	method=<method>, ( 2 or 4. The method to divide Q into slices.)
2907	( The detail of <method> will be discussed later.)
2908	Default value is 2.
2909	HOM=(i, <Bi>, <Ai>, ( higher order component in USA notation )
2910	j, <Bj>, <Aj>, ( Systematic error Only )
2911	............ ( Random errors are assigned )
2912	n, <Bn>, <An>); ( in a Program File using procedures )
2913
2914	Example
2915
2916	B: multipole, L=0.70, T=10.0, T1=5.0, T2=5.0,
2917	HOM=(2, -1.0, 0), N=8, Method=2;
2918
2919
2920	QF: multipole, L=0.70,
2921	HOM=(2, 2.50, 0.0,
2922	4, 1.01e7, 0.0),
2923	N=8, Method=2;
2924
2925	**************************************************************************/
2926
2927	case mpsym: /4/
2928	getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
2929	GetSym__(&V);
2930	QL = 0.0; /* L */
2931	QK = 0.0; /* K */
2932	k1 = 1; /* N */
2933	t = 0.0; /* T */
2934	t1 = 0.0; /* T1 */
2935	t2 = 0.0; /* T2 */
2936	h1 = 0.0;
2937	h2 = 0.0;
2938	gap = 0.0; /* gap */
2939	k2 = Meth_Fourth; /* method */
2940	dt = 0.0;
2941	ClearHOMandDBN(&V);
2942	P_addset(P_expset(mysys, 0), (long)lsym);
2943	P_addset(mysys, (long)nsym);
2944	P_addset(mysys, (long)mthsym);
2945	P_addset(mysys, (long)tsym);
2946	P_addset(mysys, (long)t1sym);
2947	P_addset(mysys, (long)t2sym);
2948	P_addset(mysys, (long)h1sym);
2949	P_addset(mysys, (long)h2sym);
2950	P_addset(mysys, (long)gapsym);
2951	P_addset(mysys, (long)rollsym);
2952	P_addset(mysys, (long)homsym);
2953	P_addset(mysys, (long)dbnsym);
2954	do { /* read L, K, N */
2955	test__(mysys, "illegal parameter", &V);
2956	sym1 = *V.sym;
2957	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
2958	switch (sym1) {
2959
2960	case lsym:
2961	QL = EVAL_(&V);
2962	break;
2963
2964	case nsym:
2965	k1 = (long)floor(EVAL_(&V) + 0.5);
2966	break;
2967
2968	case tsym:
2969	t = EVAL_(&V);
2970	break;
2971
2972	case rollsym:
2973	dt = EVAL_(&V);
2974	break;
2975
2976	case t1sym:
2977	t1 = EVAL_(&V);
2978	break;
2979
2980	case t2sym:
2981	t2 = EVAL_(&V);
2982	break;
2983
2984	case h1sym:
2985	h1 = EVAL_(&V);
2986	break;
2987
2988	case h2sym:
2989	h2 = EVAL_(&V);
2990	break;
2991
2992	case gapsym:
2993	gap = EVAL_(&V);
2994	break;
2995
2996	case mthsym:
2997	k2 = (long)floor(EVAL_(&V) + 0.5);
2998	if (k2 != Meth_Linear) globval.MatMeth = false;
2999	if ((unsigned int)k2 >= 32 \|\|
3000	((1 << k2) & ((1 << Meth_Linear) \| (1 << Meth_Second) \|
3001	(1 << Meth_Fourth))) == 0)
3002	getest__(P_expset(SET, 0), "Check integrator..", &V);
3003	break;
3004
3005	case homsym:
3006	GetHOM(&V);
3007	break;
3008
3009	case dbnsym:
3010	GetDBN_(&V);
3011	break;
3012	default:
3013	break;
3014	}
3015	test__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3016	"<, > or <;> expected", &V);
3017	if (*V.sym == comma)
3018	GetSym__(&V);
3019	} while (P_inset(*V.sym, mysys));
3020	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
3021	GetSym__(&V);
3022	globval.Elem_nFam++;
3023	if (globval.Elem_nFam <= Elem_nFamMax) {
3024	WITH = &ElemFam[globval.Elem_nFam-1];
3025	WITH1 = &WITH->ElemF;
3026	Mpole_Alloc(&WITH->ElemF);
3027	WITH2 = WITH1->M;
3028	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3029	WITH1->Pkind = Mpole;
3030	WITH1->PL = QL;
3031	if (WITH1->PL != 0e0) {
3032	WITH2->Pthick = pthicktype(thick);
3033	WITH2->Pirho = t * M_PI / 180.0 / WITH1->PL;
3034	} else {
3035	WITH2->Pthick = pthicktype(thin);
3036	WITH2->Pirho = t * M_PI / 180.0;
3037	}
3038	WITH2->PN = k1; WITH2->Pmethod = k2;
3039	WITH2->PTx1 = t1; WITH2->PTx2 = t2;
3040	WITH2->PH1 = h1; WITH2->PH2 = h2;
3041	WITH2->Pgap = gap;
3042	WITH2->PdTpar = dt;
3043	AssignHOM(globval.Elem_nFam, &V);
3044	WITH2->n_design = WITH2->Porder;
3045	SetDBN(&V);
3046	} else {
3047	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3048	globval.Elem_nFam, (long)Elem_nFamMax);
3049	exit_(1);
3050	}
3051	break;
3052
3053	/************************************************************************
3054	Wiggler
3055	*************************************************************************
3056
3057	<name>: Wiggler,
3058	L = <length [m]>,
3059	BoBrhoV = <B/Brho [1/m]>,
3060	BoBrhoH = <B/Brho [1/m]>,
3061	Lambda = <period [m]>,
3062	kxV = <[m]>,
3063	kxH = <[m]>,
3064	phi = <phase [deg]>,
3065	harm(n, kxV, BoBrhoV, kxH, BoBrhoH, phi)
3066	...
3067	N = <no of integration steps>,
3068	Method = <method>,
3069
3070	Example
3071
3072	U143: wiggler, L=4.80, K=0.5, Lambda=0.15, N=20, Method=0;
3073
3074	EPU: wiggler, L=4.80, Lambda=0.15, N=20, Method=0,
3075	harm=(3, kxV_3, BoBrhoV_3, kxH_3, BoBrhoH_3, phi_3,
3076	...
3077	5, kxV_5, BoBrhoV_5, kxH_5, BoBrhoH_5, phi_5);
3078
3079	**************************************************************************/
3080
3081	case wglsym:
3082	getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3083	GetSym__(&V);
3084	QL = 0e0;
3085	QK = 0e0;
3086	QKV = 0e0;
3087	QKH = 0e0;
3088	QKxV = 0e0;
3089	QKxH = 0e0;
3090	QPhi = 0e0;
3091	QKS = 0e0;
3092	k1 = 1;
3093	k2 = Meth_Fourth;
3094	dt = 0e0;
3095	ClearHOMandDBN(&V);
3096	P_addset(P_expset(mysys, 0), (long)lsym);
3097	P_addset(mysys, (long)lmdsym);
3098	P_addset(mysys, (long)bobrhovsym);
3099	P_addset(mysys, (long)bobrhohsym);
3100	P_addset(mysys, (long)kxvsym);
3101	P_addset(mysys, (long)kxhsym);
3102	P_addset(mysys, (long)phisym);
3103	P_addset(mysys, (long)harmsym);
3104	P_addset(mysys, (long)nsym);
3105	P_addset(mysys, (long)mthsym);
3106	P_addset(mysys, (long)rollsym);
3107	P_addset(mysys, (long)dbnsym);
3108	do {
3109	test__(mysys, "illegal parameter", &V);
3110	sym1 = *V.sym;
3111	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3112	switch (sym1) { /6/
3113
3114	case lsym:
3115	QL = EVAL_(&V);
3116	break;
3117
3118	case bobrhovsym:
3119	QKV = EVAL_(&V);
3120	break;
3121
3122	case bobrhohsym:
3123	QKH = EVAL_(&V);
3124	break;
3125
3126	case kxvsym:
3127	QKxV = EVAL_(&V);
3128	break;
3129
3130	case kxhsym:
3131	QKxH = EVAL_(&V);
3132	break;
3133
3134	case phisym:
3135	QPhi = EVAL_(&V);
3136	break;
3137
3138	case nsym:
3139	k1 = (long)floor(EVAL_(&V) + 0.5);
3140	break;
3141
3142	case mthsym:
3143	k2 = (long)floor(EVAL_(&V) + 0.5);
3144	if (k2 != Meth_Linear) globval.MatMeth = false;
3145	if ((unsigned int)k2 >= 32 \|\|
3146	((1 << k2) &
3147	((1 << Meth_Linear) \| (1 << Meth_First) \| (1 << Meth_Second) \|
3148	(1 << Meth_Fourth) \| (1 << Meth_genfun))) == 0)
3149	getest__(P_expset(SET, 0), "Check integrator..", &V);
3150	break;
3151
3152	case lmdsym:
3153	QKS = EVAL_(&V);
3154	break;
3155
3156	case rollsym:
3157	dt = EVAL_(&V);
3158	break;
3159
3160	case harmsym:
3161	GetHarm(&V);
3162	break;
3163
3164	case dbnsym:
3165	GetDBN_(&V);
3166	break;
3167
3168	default:
3169	break;
3170	}
3171	test__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3172	"<, > or <;> expected", &V);
3173	if (*V.sym == comma)
3174	GetSym__(&V);
3175	} while (P_inset(V.sym, mysys)); /5*/
3176	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3177	GetSym__(&V);
3178	globval.Elem_nFam++;
3179	if (globval.Elem_nFam <= Elem_nFamMax) {
3180	WITH = &ElemFam[globval.Elem_nFam-1]; WITH1 = &WITH->ElemF;
3181	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3182	WITH1->PL = QL; WITH1->Pkind = Wigl;
3183	Wiggler_Alloc(&WITH->ElemF); WITH4 = WITH1->W;
3184	WITH4->Pmethod = k2; WITH4->PN = k1;
3185	WITH4->PdTpar = dt;
3186	SetDBN(&V);
3187	WITH4->lambda = QKS; WITH4->n_harm = 1; WITH4->harm[0] = 1;
3188	WITH4->kxV[0] = QKxV; WITH4->BoBrhoV[0] = QKV;
3189	WITH4->kxH[0] = QKxH; WITH4->BoBrhoH[0] = QKH;
3190	WITH4->phi[0] = QPhi;
3191	AssignHarm(globval.Elem_nFam, &V);
3192	/* Equivalent vertically focusing gradient */
3193	WITH4->PBW[HOMmax+2] = -QK*QK/2e0;
3194	CheckWiggler(globval.Elem_nFam, &V);
3195	} else {
3196	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3197	globval.Elem_nFam, (long)Elem_nFamMax);
3198	exit_(1);
3199	}
3200	break;
3201
3202	/************************************************************************
3203	Field Map
3204	*************************************************************************
3205
3206	<name> : Fieldmap,
3207	L = <length [m]>,
3208	N = <no of integration steps>,
3209	file1 = <file name (lower case)>
3210
3211	Example
3212
3213	FM: Fieldmap, L = 1.0, N = 20, file1 = "U19_Bxyz.dat";
3214
3215	**************************************************************************/
3216
3217	case fmsym:
3218	getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3219	GetSym__(&V);
3220	QL = 0.0;
3221	k1 = 1;
3222	strcpy(str1, "");
3223	strcpy(str2, "");
3224	P_addset(P_expset(mysys, 0), (long)lsym);
3225	P_addset(mysys, (long)nsym);
3226	P_addset(mysys, (long)fnamesym1);
3227	P_addset(mysys, (long)fnamesym2);
3228	do {
3229	test__(mysys, "illegal parameter", &V);
3230	sym1 = *V.sym;
3231	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3232	switch (sym1) { /6/
3233
3234	case lsym:
3235	QL = EVAL_(&V);
3236	break;
3237
3238	case nsym:
3239	k1 = (long)floor(EVAL_(&V) + 0.5);
3240	break;
3241
3242	case fnamesym1:
3243	GetSym__(&V);
3244	for (i = 1; i < (signed)strlen(id_); i++) {
3245	if (id_[i] == '"') break;
3246	strncat(str1, &id_[i], 1);
3247	}
3248	GetSym__(&V);
3249	break;
3250
3251	default:
3252	break;
3253	}
3254	test__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3255	"<, > or <;> expected", &V);
3256	if (*V.sym == comma)
3257	GetSym__(&V);
3258	} while (P_inset(V.sym, mysys)); /5*/
3259	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3260	GetSym__(&V);
3261	globval.Elem_nFam++;
3262	if (globval.Elem_nFam <= Elem_nFamMax) {
3263	WITH = &ElemFam[globval.Elem_nFam-1]; WITH1 = &WITH->ElemF;
3264	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3265	WITH1->PL = QL; WITH1->Pkind = FieldMap;
3266	FieldMap_Alloc(WITH1, true);
3267	WITH6 = WITH1->FM; WITH6->n_step = k1;
3268	if (CheckUDItable("energy ", LINK) != 0) {
3269	RefUDItable("energy ", &globval.Energy, LINK);
3270	if (strcmp(str1, "") != 0) get_B(str1, WITH6);
3271	} else {
3272	cout << "Fieldmap: energy not defined" << endl;
3273	exit_(1);
3274	}
3275	} else {
3276	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3277	globval.Elem_nFam, (long)Elem_nFamMax);
3278	exit_(1);
3279	}
3280	break;
3281
3282	/**********************************************************************
3283	Insertion introduced for SOLEIL using Radia Maps
3284	***********************************************************************
3285
3286	<name> : insertion,
3287	N = <number of thin lenses>,
3288	scaling1 or 2 = scaling factor: should be 1. Default value
3289	file1 = <filename>, in lowercase (first order defaults)
3290	file2 = <filename>, in lowercase (second order defaults)
3291	method = <method>, ( 1 or 3. The method to divide Q into slices.)
3292	( The detail of <method> will be discussed later.)
3293
3294	Example
3295
3296	ID1 : insertion, scaling2 = 1, N=10, file2="hu80_lh";
3297	ID2 : insertion, scaling1 = 1, N=10, file1="hu80_lh_bdl";
3298	ID3 : insertion, N=10, file1="hu80_lh_dbl"; file2="hu80_lh";
3299
3300	Notes
3301	file1 and file2 must have the same structures and meshing
3302	optional parameter scaling must be at first (weird bug otherwise)
3303	**************************************************************************/
3304
3305	case idsym:
3306	getest__(P_expset(SET, 1L << ((long) comma)), "<, > expected", &V);
3307	GetSym__(&V);
3308	QK = 0e0;
3309	QKxV = 0e0;
3310	QKS = 0e0;
3311	k1 = 1; // number of slices of the lattice element
3312	k2 = 3; // 1 linear interpolation, 3 spline interpolation
3313	dt = 0e0;
3314	scaling1 = 1.0; // scaling factor
3315	scaling2 = 1.0; // scaling factor
3316	P_addset(P_expset(mysys, 0), (long) nsym);
3317	P_addset(mysys, (long) fnamesym1);
3318	P_addset(mysys, (long) fnamesym2);
3319	P_addset(mysys, (long) scalingsym1);
3320	P_addset(mysys, (long) scalingsym2);
3321	P_addset(mysys, (long) mthsym);
3322	do {
3323	test__(mysys, "illegal parameter", &V);
3324	sym1 = *V.sym;
3325	getest__(P_expset(SET, 1L << ((long) eql)), "<=> expected", &V);
3326
3327	//read the parameters setting from the lattice
3328	switch (sym1) {
3329
3330	case nsym: /* Read number of slices */
3331	k1 = abs((long) floor(EVAL_(&V)));
3332	GetSym__(&V);
3333	break;
3334
3335	case scalingsym1: /* read scaling factor for debugging purpose*/
3336	scaling1 = EVAL_(&V);
3337	break;
3338
3339	case scalingsym2: /* read scaling factor for debugging purpose*/
3340	scaling2 = EVAL_(&V);
3341	break;
3342
3343	case fnamesym1: /* Read filename for insertion device first order kicks*/
3344	firstflag = true;
3345	GetSym__(&V);
3346	for (i = 1; i < (signed) strlen(id_); i++) {
3347	if (id_[i] == '"')
3348	break;
3349	strncat(str1, &id_[i], 1);
3350	}
3351	GetSym__(&V);
3352	break;
3353
3354	case fnamesym2: /* Read filename for insertion
3355	device second order kicks */
3356	secondflag = true;
3357	GetSym__(&V);
3358	for (i = 1; i < (signed) strlen(id_); i++) {
3359	if (id_[i] == '"')
3360	break;
3361	strncat(str2, &id_[i], 1);
3362	}
3363	GetSym__(&V);
3364	break;
3365
3366	case mthsym: // method for interpolation: 1 means linear 3 spline
3367	k2 = (long) floor(EVAL_(&V));
3368	if (k2 != Meth_Linear)
3369	globval.MatMeth = false;
3370	break;
3371	default:
3372	break;
3373	}
3374	if (*V.sym == comma)
3375	GetSym__(&V);
3376	} while (P_inset(V.sym, mysys)); /5*/
3377	GetSym__(&V);
3378	globval.Elem_nFam++;
3379
3380	/* Fills up the ID */
3381	if (globval.Elem_nFam <= Elem_nFamMax) {
3382	WITH = &ElemFam[globval.Elem_nFam - 1];
3383	WITH1 = &WITH->ElemF;
3384	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3385	WITH1->Pkind = Insertion;
3386	Insertion_Alloc(&WITH->ElemF);
3387	WITH5 = WITH1->ID;
3388	WITH5->Pmethod = k2;
3389	WITH5->PN = k1;
3390	WITH5->scaling1 = scaling1;
3391	WITH5->scaling2 = scaling2;
3392
3393	// Check if filename given for first order kicks
3394	if (firstflag) {
3395	if (strcmp(str1, "") == 0)
3396	strcpy(WITH5->fname1, "/No_Filename1_Given/");
3397	strcpy(WITH5->fname1, str1);
3398	// Read Id file for first order kicks
3399	WITH5->firstorder = true;
3400	Read_IDfile(WITH5->fname1, &WITH1->PL, &WITH5->nx1,
3401	&WITH5->nz1, WITH5->tabx1, WITH5->tabz1, WITH5->thetax1,
3402	WITH5->thetaz1);
3403	} else {
3404	strcpy(WITH5->fname1, "/No_Filename1_Given/");
3405	}
3406
3407	// Check if filename given for Second order kicks
3408	if (secondflag) {
3409	if (strcmp(str2, "") != 0)
3410	strcpy(WITH5->fname2, "/No_Filename2_Given/");
3411	strcpy(WITH5->fname2, str2);
3412	WITH5->secondorder = secondflag;
3413	// Read Id file for second order kicks
3414	Read_IDfile(WITH5->fname2, &WITH1->PL, &WITH5->nx2,
3415	&WITH5->nz2, WITH5->tabx2, WITH5->tabz2,
3416	WITH5->thetax2, WITH5->thetaz2);
3417	} else {
3418	strcpy(WITH5->fname2, "/No_Filename2_Given/");
3419	}
3420
3421	// check whether no Radia filename read: something is wrong
3422	if (!firstflag && !secondflag) {
3423	printf("Error no Insertion filename found as"
3424	" an input in lattice file\n");
3425	exit_(-1);
3426	}
3427
3428	if (k2 == 3 \| k2 == 2) { // cubic interpolation
3429	WITH5->linear = false;
3430	} else { // linear interpolation
3431	WITH5->linear = true;
3432	}
3433
3434	// stuff for spline interpolation
3435	if (!WITH5->linear) {
3436	if (firstflag){
3437	WITH5->tx1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3438	WITH5->tz1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3439	WITH5->TabxOrd1 = (double ) malloc((WITH5->nx1) sizeof(double));
3440	WITH5->TabzOrd1 = (double ) malloc((WITH5->nz1) sizeof(double));
3441	WITH5->f2x1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3442	WITH5->f2z1 = dmatrix(1, WITH5->nz1, 1, WITH5->nx1);
3443	Matrices4Spline(WITH5,1);}
3444
3445	if (secondflag){
3446	WITH5->tx2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3447	WITH5->tz2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3448	WITH5->TabxOrd2 = (double ) malloc((WITH5->nx2) sizeof(double));
3449	WITH5->TabzOrd2 = (double ) malloc((WITH5->nz2) sizeof(double));
3450	WITH5->f2x2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3451	WITH5->f2z2 = dmatrix(1, WITH5->nz2, 1, WITH5->nx2);
3452	Matrices4Spline(WITH5,2);}
3453
3454	}
3455	// to put somewhere
3456	// / Free memory /
3457	// free(tab1);
3458	// free(tab2);
3459	//
3460	// free_matrix(tx,1,nz,1,nx);
3461	// free_matrix(tz,1,nz,1,nx);
3462	// free_matrix(f2x,1,nz,1,nx);
3463	// free_matrix(f2z,1,nz,1,nx);
3464
3465	} else {
3466	printf("Elem_nFamMax exceeded: %ld(%ld)\n", globval.Elem_nFam,
3467	(long) Elem_nFamMax);
3468	exit_(1);
3469	}
3470	break;
3471
3472	/**************************************************************************
3473	Spreader
3474	**************************************************************************
3475
3476	<name>: Spreader,
3477
3478	Example
3479
3480	S1: Spreader;
3481
3482	*************************************************************************/
3483
3484	case sprsym:
3485	getest__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3486	"<, > or <;> expected", &V);
3487	if (*V.sym == comma) {
3488	getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
3489	"illegal parameter", &V);
3490	sym1 = *V.sym;
3491	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3492	if (sym1 == dbnsym)
3493	GetDBN_(&V);
3494	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3495	}
3496	GetSym__(&V);
3497	globval.Elem_nFam++;
3498	if (globval.Elem_nFam <= Elem_nFamMax) {
3499	WITH = &ElemFam[globval.Elem_nFam-1];
3500	WITH1 = &WITH->ElemF;
3501	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3502	WITH1->PL = *V.rnum;
3503	WITH1->Pkind = PartsKind(Spreader);
3504	Spreader_Alloc(&WITH->ElemF);
3505	} else {
3506	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3507	globval.Elem_nFam, (long)Elem_nFamMax);
3508	exit_(1);
3509	}
3510	break;
3511
3512	/**************************************************************************
3513	Recombiner
3514	**************************************************************************
3515
3516	<name>: Recombiner,
3517
3518	Example
3519
3520	S1: Recombiner;
3521
3522	*************************************************************************/
3523
3524	case recsym:
3525	getest__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3526	"<, > or <;> expected", &V);
3527	if (*V.sym == comma) {
3528	getest__(P_addset(P_expset(SET4, 0), (long)dbnsym),
3529	"illegal parameter", &V);
3530	sym1 = *V.sym;
3531	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3532	if (sym1 == dbnsym)
3533	GetDBN_(&V);
3534	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", &V);
3535	}
3536	GetSym__(&V);
3537	globval.Elem_nFam++;
3538	if (globval.Elem_nFam <= Elem_nFamMax) {
3539	WITH = &ElemFam[globval.Elem_nFam-1];
3540	WITH1 = &WITH->ElemF;
3541	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3542	WITH1->PL = *V.rnum;
3543	WITH1->Pkind = PartsKind(Recombiner);
3544	Recombiner_Alloc(&WITH->ElemF);
3545	} else {
3546	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3547	globval.Elem_nFam, (long)Elem_nFamMax);
3548	exit_(1);
3549	}
3550	break;
3551
3552	/**************************************************************************
3553	Solenoid
3554	***************************************************************************
3555
3556	<name>: Solenoid,
3557	L=<length>, ( [m] )
3558	BoBrho = <B/Brho [1/m]>,
3559	N =<# of kicks>,
3560	method=<method>
3561
3562	Example
3563
3564	B: solenoid, L=0.70, BoBrho=10.0;
3565
3566	**************************************************************************/
3567
3568	case solsym:
3569	getest__(P_expset(SET, 1 << ((long)comma)), "<, > expected", &V);
3570	GetSym__(&V);
3571	QL = 0.0; /* L */
3572	QK = 0.0; /* K */
3573	k1 = 1; /* N */
3574	P_addset(P_expset(mysys, 0), (long)lsym);
3575	P_addset(mysys, (long)bobrhosym);
3576	P_addset(mysys, (long)nsym);
3577	do { /* read L, K, N */
3578	test__(mysys, "illegal parameter", &V);
3579	sym1 = *V.sym;
3580	getest__(P_expset(SET, 1 << ((long)eql)), "<=> expected", &V);
3581	switch (sym1) {
3582
3583	case lsym:
3584	QL = EVAL_(&V);
3585	break;
3586
3587	case bobrhosym:
3588	QK = EVAL_(&V);
3589	break;
3590
3591	case nsym:
3592	k1 = (long)floor(EVAL_(&V) + 0.5);
3593	break;
3594
3595	default:
3596	cout << "Solenoid: undef. case" << endl;
3597	exit_(1);
3598	break;
3599	}
3600	test__(P_expset(SET, (1 << ((long)comma)) \| (1 << ((long)semicolon))),
3601	"<, > or <;> expected", &V);
3602	if (*V.sym == comma)
3603	GetSym__(&V);
3604	} while (P_inset(*V.sym, mysys));
3605	test__(P_expset(SET, 1 << ((long)semicolon)), "<;> expected.", &V);
3606	GetSym__(&V);
3607	globval.Elem_nFam++;
3608	if (globval.Elem_nFam <= Elem_nFamMax) {
3609	WITH = &ElemFam[globval.Elem_nFam-1];
3610	WITH1 = &WITH->ElemF;
3611	Solenoid_Alloc(&WITH->ElemF);
3612	WITH7 = WITH1->Sol;
3613	memcpy(WITH1->PName, ElementName, sizeof(partsName));
3614	WITH1->Pkind = Solenoid;
3615	WITH1->PL = QL; WITH7->N = k1; WITH7->BoBrho = QK;
3616	} else {
3617	printf("Elem_nFamMax exceeded: %ld(%ld)\n",
3618	globval.Elem_nFam, (long)Elem_nFamMax);
3619	exit_(1);
3620	}
3621	break;
3622
3623	/**************************************************************************
3624	BLOCK DEFINITION
3625	**************************************************************************/
3626
3627	case ident:
3628	case intcon:
3629	case invsym: /* Block Definition */
3630	ProcessBlockInput(&V);
3631	break;
3632	default:
3633	break;
3634	}/3.5:of CASE/
3635
3636	Result = true;
3637
3638	_L9999:
3639
3640	return Result;
3641	} /of procedure Lat_DealElement/
3642
3643
3644	static void errorm___(const char cmnt, struct LOC_Lattice_Read LINK)
3645	{
3646	/write(fo, ' **')/
3647	/error/
3648	if (LINK->cc > LINK->errpos) {
3649	fprintf(LINK->fo, "%c^%.80s", (int)(LINK->cc - LINK->errpos),
3650	' ', cmnt);
3651	LINK->errpos = LINK->cc + 3;
3652	}
3653	while (!P_eof(*LINK->fi))
3654	Lat_Nextch(LINK->fi, LINK->fo, &LINK->cc, &LINK->ll, &LINK->errpos,
3655	&LINK->lc, &LINK->chin, &LINK->skipflag, LINK->line, LINK);
3656	ErrFlag = true;
3657	longjmp(LINK->_JL9999, 1);
3658	}
3659
3660
3661	static void GetSym___(struct LOC_Lattice_Read *LINK)
3662	{
3663	/* reads next symbol */
3664	/GetSym/
3665	Lat_GetSym(LINK->fi, LINK->fo, &LINK->cc, &LINK->ll, &LINK->errpos,
3666	&LINK->lc, &LINK->nkw, &LINK->inum, (long)emax, (long)emin,
3667	(long)kmax, nmax, &LINK->chin, LINK->id, &LINK->rnum,
3668	&LINK->skipflag, &LINK->rsvwd, LINK->line, &LINK->sym, LINK->key,
3669	LINK->ksy, LINK->sps, LINK);
3670	}
3671
3672
3673	static void test___(long s1, const char cmnt, struct LOC_Lattice_Read *LINK)
3674	{
3675	/test/
3676	if (!P_inset(LINK->sym, s1))
3677	errorm___(cmnt, LINK);
3678	}
3679
3680
3681	static void getest___(long s1, const char cmnt, struct LOC_Lattice_Read *LINK)
3682	{
3683	/test/
3684	GetSym___(LINK);
3685	if (!P_inset(LINK->sym, s1))
3686	errorm___(cmnt, LINK);
3687	}
3688
3689
3690	/* Local variables for init_reserved_words: */
3691	struct LOC_init_reserved_words
3692	{
3693	struct LOC_Lattice_Read *LINK;
3694	};
3695
3696
3697	static void Reg(const char *name, Lat_symbol ks,
3698	struct LOC_init_reserved_words *LINK)
3699	{
3700	LINK->LINK->nkw++; /* incrementation of the number of keywords */
3701	if (LINK->LINK->nkw > Lat_nkw_max) {
3702	cout << "Reg: Lat_nkw_max exceeded " << LINK->LINK->nkw
3703	<< "(" << Lat_nkw_max << ")" << endl;
3704	}
3705	memcpy(LINK->LINK->key[LINK->LINK->nkw - 1], name, sizeof(alfa_));
3706	LINK->LINK->ksy[LINK->LINK->nkw - 1] = ks;
3707	}
3708
3709
3710	static void init_reserved_words(struct LOC_Lattice_Read *LINK)
3711	{
3712	struct LOC_init_reserved_words V;
3713
3714	V.LINK = LINK;
3715	LINK->nkw = 0; /* Number of keywords equals zero */
3716	/*-------------------------------------------------------------
3717	To define reserved symbol in the lattice reading,
3718	MUST follow alphabetical list !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3719	--------------------------------------------------------------*/
3720	Reg("and ", andsym, &V);
3721	Reg("beam ", bemsym, &V);
3722	Reg("bending ", bndsym, &V);
3723	Reg("cavity ", cavsym, &V);
3724	Reg("cell ", celsym, &V);
3725	Reg("chromaticity ", chmsym, &V);
3726	Reg("corrector ", corsym, &V); /* corrector */
3727	Reg("dbname ", dbnsym, &V);
3728	Reg("define ", defsym, &V);
3729	Reg("dispersion ", dspsym, &V);
3730	Reg("drift ", drfsym, &V);
3731	Reg("dt ", dtsym, &V);
3732	Reg("edge_effect1 ", edge_effect1sym, &V); /* Jianfeng Zhang*/
3733	Reg("edge_effect2 ", edge_effect2sym, &V); /* Jianfeng Zhang */
3734	Reg("end ", endsym, &V);
3735	Reg("ff1 ", ff1sym, &V); /* Laurent */
3736	Reg("ff2 ", ff2sym, &V); /* Laurent */
3737	Reg("ffscaling ", ffscalingsym, &V);/* quadff scaling J.Zhang */
3738	Reg("fieldmap ", fmsym, &V);
3739	Reg("file1 ", fnamesym1, &V); /* ID Laurent */
3740	Reg("file2 ", fnamesym2, &V); /* ID Laurent */
3741	Reg("focusing ", fcssym, &V);
3742	Reg("frequency ", frqsym, &V);
3743	Reg("fringe ", frgsym, &V);
3744	Reg("galilean ", xytsym, &V);
3745	Reg("gap ", gapsym, &V);
3746	Reg("ghost ", gstsym, &V);
3747	Reg("h1 ", h1sym, &V);
3748	Reg("h2 ", h2sym, &V);
3749	Reg("harm ", harmsym, &V);
3750	Reg("harnum ", harnumsym, &V);
3751	Reg("hom ", homsym, &V);
3752	Reg("horizontal ", horsym, &V); /* with "corrector", define the horizontal corrector in the lattice*/
3753	Reg("insertion ", idsym, &V); /* ID Laurent */
3754	Reg("inv ", invsym, &V);
3755	Reg("kick ", corkicksym, &V); /* with "corrector", define the kick angle of the corrector , Jianfeng Zhang*/
3756	//Reg("kicker ", kicksym, &V); /overlap with the lattice element type: corrector/
3757	Reg("ks ", kssym, &V);
3758	Reg("lambda ", lmdsym, &V);
3759	Reg("lattice ", latsym, &V);
3760	Reg("marker ", mrksym, &V);
3761	Reg("matrix ", matsym, &V);
3762	Reg("method ", mthsym, &V);
3763	Reg("monitor ", monsym, &V);
3764	Reg("multipole ", mpsym, &V);
3765	Reg("nonlinear ", nbdsym, &V);
3766	Reg("parameter ", prmsym, &V);
3767	Reg("position ", possym, &V);
3768	Reg("print ", prnsym, &V);
3769	Reg("quadrupole ", qdsym, &V);
3770	Reg("recombiner ", recsym, &V);
3771	Reg("roll ", rollsym, &V);
3772	Reg("scaling1 ", scalingsym1, &V); /* ID Laurent */
3773	Reg("scaling2 ", scalingsym2, &V); /* ID Laurent */
3774	Reg("sextupole ", sexsym, &V);
3775	Reg("solenoid ", solsym, &V);
3776	Reg("spreader ", sprsym, &V);
3777	Reg("symmetry ", symsym, &V);
3778	Reg("t1 ", t1sym, &V);
3779	Reg("t2 ", t2sym, &V);
3780	Reg("table ", tblsym, &V);
3781	Reg("task ", tsksym, &V);
3782	Reg("tilt ", tiltsym, &V); // added for compatibility with Tracy II
3783	Reg("type ", typsym, &V);
3784	Reg("use ", usesym, &V);
3785	Reg("vertical ", versym, &V); /* with "corrector", define the vertical corrector in the lattice*/
3786	Reg("voltage ", vrfsym, &V);
3787	Reg("wiggler ", wglsym, &V);
3788
3789	if (trace) fprintf(stdout,"Nb of keywords = %ld (%d)\n",
3790	LINK->nkw, Lat_nkw_max);
3791
3792	LINK->sps[(int)'+'] = plus_;
3793	LINK->sps[(int)'-'] = minus_;
3794	LINK->sps[(int)'('] = lparent;
3795	LINK->sps[(int)')'] = rparent;
3796	LINK->sps[(int)'='] = eql;
3797	LINK->sps[(int)','] = comma;
3798	LINK->sps[(int)'['] = lbrack;
3799	LINK->sps[(int)']'] = rbrack;
3800	LINK->sps[(int)'\''] = squote;
3801	LINK->sps[(int)'&'] = andsy;
3802	LINK->sps[(int)';'] = semicolon;
3803	LINK->sps[(int)'/'] = rdiv;
3804	LINK->sps[(int)':'] = colon;
3805
3806	if (trace)
3807	printf("%d %d %d %d %d %d %d %d %d %d %d %d %d %d \n",
3808	(int)'+', (int)'-', (int)'(', (int)')', (int)'=',
3809	(int)',', (int)'[', (int)'[', (int)']', (int)'\'',
3810	(int)'&', (int)';', (int)'/', (int)':');
3811
3812	LINK->lc = 0; /* reset line counter */
3813	LINK->ll = 0; /* reset line length */
3814	LINK->cc = 0; /* reset char counter */
3815	LINK->errpos = 0; /* reset error position */
3816	LINK->chin = ' '; /* reset current char */
3817	LINK->skipflag = false; /* reset skip flag */
3818	P_addset(P_expset(LINK->defbegsys, 0), (long)ident);
3819	P_addset(P_expset(LINK->elmbegsys, 0), (long)qdsym);
3820	P_addset(LINK->elmbegsys, (long)sexsym); /link the lattice element name/
3821	P_addset(LINK->elmbegsys, (long)corsym);
3822	P_addset(LINK->elmbegsys, (long)bemsym);
3823	P_addset(LINK->elmbegsys, (long)gstsym);
3824	P_addset(LINK->elmbegsys, (long)mrksym);
3825	P_addset(LINK->elmbegsys, (long)nbdsym);
3826	P_addset(LINK->elmbegsys, (long)frgsym);
3827	P_addset(LINK->elmbegsys, (long)xytsym);
3828	P_addset(LINK->elmbegsys, (long)drfsym);
3829	P_addset(LINK->elmbegsys, (long)bndsym);
3830	P_addset(LINK->elmbegsys, (long)wglsym);
3831	P_addset(LINK->elmbegsys, (long)mpsym);
3832	P_addset(LINK->elmbegsys, (long)cavsym);
3833	P_addset(LINK->elmbegsys, (long)idsym); /* ID Laurent */
3834	P_addset(LINK->elmbegsys, (long)fmsym);
3835	P_addset(LINK->elmbegsys, (long)sprsym);
3836	P_addset(LINK->elmbegsys, (long)recsym);
3837	P_addset(LINK->elmbegsys, (long)solsym);
3838	P_addset(LINK->elmbegsys, (long)fnamesym1); /* ID file name Laurent */
3839	P_addset(LINK->elmbegsys, (long)fnamesym2); /* ID file name Laurent */
3840	// P_addset(LINK->elmbegsys, (long)scalingsym); /* ID scale factor Laurent */
3841	}
3842
3843	/* Local variables for DealWithDefns: */
3844	struct LOC_DealWithDefns
3845	{
3846	struct LOC_Lattice_Read *LINK;
3847	};
3848
3849	static double EVAL__(struct LOC_DealWithDefns *LINK)
3850	{
3851	return (Lat_EVAL(LINK->LINK->fi, LINK->LINK->fo, &LINK->LINK->cc,
3852	&LINK->LINK->ll, &LINK->LINK->errpos, &LINK->LINK->lc,
3853	&LINK->LINK->nkw, &LINK->LINK->inum, (long)emax,
3854	(long)emin, (long)kmax, nmax, &LINK->LINK->chin,
3855	LINK->LINK->id, &LINK->LINK->rnum, &LINK->LINK->skipflag,
3856	&LINK->LINK->rsvwd, LINK->LINK->line, &LINK->LINK->sym,
3857	LINK->LINK->key, LINK->LINK->ksy, LINK->LINK->sps,
3858	LINK->LINK));
3859	}
3860
3861
3862	/******************************************************
3863	* *
3864	* P A R S E R *
3865	* *
3866	******************************************************/
3867
3868	static void DealWithDefns(struct LOC_Lattice_Read *LINK)
3869	{ /0/
3870	struct LOC_DealWithDefns V;
3871	partsName idsave, ElementName, BlockName, IdentName;
3872	long i, j, k, k1;
3873	symset SET;
3874	long SET1[(long)ident / 32 + 2];
3875	long SET2[(long)period_ / 32 + 2];
3876	long SET3[(long)invsym / 32 + 2];
3877	_REC_BlockStype *WITH;
3878	long FORLIM;
3879	long SET4[(long)symsym / 32 + 2];
3880	long SET5[(long)endsym / 32 + 2];
3881
3882	/************ DEAL WITH DEFINITIONS *******************************/
3883
3884	V.LINK = LINK;
3885	GetSym___(LINK);
3886	if (LINK->sym != latsym) { /1/
3887	test___(P_expset(SET, 0), "<illegal operand> detected", LINK);
3888	return;
3889	}
3890	/**** The first word must be 'lattice' ********/
3891	getest___(P_expset(SET, 1 << ((long)semicolon)), "<;> expected", LINK);
3892	// Test whether expression exists
3893	getest___(P_addset(P_expset(SET1, 0), (long)ident),
3894	"<identifier> expected", LINK);
3895
3896	/***************************************************************************/
3897	if (LINK->sym == ident) {
3898	do { /2/
3899	if (LINK->sym == ident) { /2.5:-----------------------/
3900	memcpy(idsave, LINK->id, sizeof(alfa_));
3901	memset(idsave + sizeof(alfa_), ' ', sizeof(partsName) - sizeof(alfa_));
3902	memcpy(ElementName, LINK->id, sizeof(alfa_));
3903	memset(ElementName + sizeof(alfa_), ' ',
3904	sizeof(partsName) - sizeof(alfa_));
3905	memcpy(BlockName, LINK->id, sizeof(alfa_));
3906	memset(BlockName + sizeof(alfa_), ' ',
3907	sizeof(partsName) - sizeof(alfa_));
3908	P_addset(P_expset(SET2, 0), (long)colon);
3909	P_addset(SET2, (long)eql);
3910	getest___(P_addset(SET2, (long)period_),
3911	"<colon>, <=> or <.> expected", LINK);
3912	if (LINK->sym == colon) /3:of IF sym=colon/ { /3/
3913	P_addset(P_expset(SET3, 0), (long)ident);
3914	P_addset(SET3, (long)intcon);
3915	getest___(P_setunion(SET, LINK->elmbegsys,
3916	P_addset(SET3, (long)invsym)),
3917	"<identifier>, <integer> or <INV> expected", LINK);
3918	P_addset(P_expset(SET3, 0), (long)ident);
3919	P_addset(SET3, (long)intcon);
3920	if (P_inset(LINK->sym,
3921	P_setunion(SET, LINK->elmbegsys,
3922	P_addset(SET3, (long)invsym)))) {
3923	if (!Lat_DealElement(LINK->fi, LINK->fo, &LINK->cc,
3924	&LINK->ll,
3925	&LINK->errpos, &LINK->lc, &LINK->nkw,
3926	&LINK->inum, (long)emax, (long)emin,
3927	(long)kmax, nmax, &LINK->chin,
3928	LINK->id,
3929	ElementName, BlockName, &LINK->rnum,
3930	&LINK->skipflag, &LINK->rsvwd,
3931	LINK->line,
3932	&LINK->sym, LINK->key, LINK->ksy,
3933	LINK->sps, LINK))
3934	longjmp(LINK->_JL9999, 1);
3935	}
3936
3937	} else {
3938	/**************************************************************
3939	* *
3940	* P A R A M E T E R A S S I G N M E N T *
3941	* *
3942	**************************************************************/
3943
3944	if (LINK->sym == eql) { /3:of parameter/
3945	memcpy(IdentName, idsave, sizeof(partsName));
3946	i = CheckUDItable(IdentName, LINK);
3947	if (i == 0)
3948	EnterUDItable(IdentName, EVAL__(&V), LINK);
3949	else
3950	ModUDItable(i, EVAL__(&V), LINK);
3951	test___(P_expset(SET, 1 << ((long)semicolon)),
3952	"<;> expected", LINK);
3953	GetSym___(LINK);
3954	/3:of parameter/
3955	/*-----
3956	IdentName:=idsave;
3957	i:=CheckElementtable(IdentName);
3958	IF i=0 THEN Test([], '<element name> expected');
3959	getest([lsym, tsym, t1sym, t2sym, gapsym, ksym],
3960	'illegal component');
3961	sym1:=sym;
3962	getest([eql], '<=> expected');
3963	case sym1 of
3964	lsym: ElemFam[i].ElemF.PL :=Eval;
3965	ksym: ElemFam[i].ElemF.Pk :=Eval;
3966	tsym: ElemFam[i].ElemF.Pt :=Eval;
3967	t1sym: ElemFam[i].ElemF.Pt1:=Eval;
3968	t2sym: ElemFam[i].ElemF.Pt2:=Eval;
3969	gapsym: ElemFam[i].ElemF.Pgap:=Eval;
3970	END;
3971	test([semicolon], '<;> expected');
3972	GetSym;
3973	-----*/
3974	/3:of parameter /
3975	} /3:of parameter /
3976	}
3977
3978	/*****************************
3979	* *
3980	* DEAL WITH ELEMENT *
3981	* *
3982	*****************************/
3983
3984	} /2.5/
3985
3986	/**************************************************************
3987	* *
3988	* C E L L D E F I N I T I O N *
3989	* *
3990	*************************************************************
3991
3992	CELL : <block name>, SYMMETRY=<symmetry>;
3993
3994	<block name>:== name of a block.
3995	<symmetry>:== number of supersymmetry:== number of the block/ring
3996
3997	Example
3998
3999	CELL : BL1, Symmetry=12;
4000
4001	************************************************************************/
4002
4003	if (LINK->sym == celsym) { /3/
4004	getest___(P_expset(SET, 1 << ((long)colon)),
4005	"<colon> expected", LINK);
4006	getest___(P_addset(P_expset(SET1, 0), (long)ident),
4007	"<Block name> expected", LINK);
4008	i = CheckBLOCKStable(LINK->id, LINK);
4009	if (i == 0)
4010	test___(P_expset(SET, 0),
4011	"<Block name> expected", LINK);
4012	k = 0;
4013	if (i != 0) { /4/
4014	WITH = &LINK->BlockS[i - 1];
4015	FORLIM = WITH->BOWARI;
4016	for (j = WITH->BSTART - 1; j < FORLIM; j++) { /6/
4017	k++;
4018	if (j < NoBEmax)
4019	k1 = LINK->Bstack[j];
4020	else {
4021	printf("** DealWithDefns: NoBEmax exceeded %ld (%d)\n",
4022	j+1, NoBEmax);
4023	exit(1);
4024	}
4025	if (k <= Cell_nLocMax)
4026	Cell[k].Fnum = k1;
4027	else {
4028	printf("** Cell_nLocMax exhausted: %ld(%ld)\n",
4029	k, (long)Cell_nLocMax);
4030	exit_(1);
4031	}
4032	}
4033	/5/
4034	}
4035	/4/
4036	if (k <= Cell_nLocMax)
4037	globval.Cell_nLoc = k; /number of Elements in a cell/
4038	else {
4039	printf("** Cell_nLocMax exhausted: %ld(%ld)\n",
4040	k, (long)Cell_nLocMax);
4041	exit_(1);
4042	}
4043	getest___(P_expset(SET, 1 << ((long)comma)),
4044	"<, > expected", LINK);
4045	getest___(P_addset(P_expset(SET4, 0), (long)symsym),
4046	"<symmetry> expected", LINK);
4047	getest___(P_expset(SET, 1 << ((long)eql)),
4048	"<=> expected", LINK);
4049	LINK->Symmetry = (long)floor(EVAL__(&V) + 0.5);
4050	if (LINK->Symmetry >= 1)
4051	LINK->Ring = true;
4052	else {
4053	LINK->Symmetry = 1;
4054	LINK->Ring = false;
4055	}
4056	test___(P_expset(SET, 1 << ((long)semicolon)),
4057	"<;> expected", LINK);
4058	GetSym___(LINK);
4059	} /3: of celsym/
4060
4061
4062	switch (LINK->sym) { /2/
4063
4064	/******************************************
4065
4066	PRINT element-name
4067	PRINT block_name
4068	PRINT parameter
4069
4070	******************************************/
4071
4072	case prnsym: /4/
4073	getest___(P_addset(P_expset(SET1, 0), (long)ident),
4074	"<identifiler> expected", LINK);
4075	memcpy(IdentName, LINK->id, sizeof(alfa_));
4076	memset(IdentName + sizeof(alfa_), ' ',
4077	sizeof(partsName) - sizeof(alfa_));
4078	i = CheckElementtable(IdentName, LINK);
4079	if (i == 0) { /PrintElementParam(i)/
4080	i = CheckBLOCKStable(IdentName, LINK);
4081	if (i == 0) { /PrintBlockParam(i)/
4082	i = CheckUDItable(IdentName, LINK);
4083	if (i == 0)
4084	getest___(P_expset(SET, 0),
4085	" invalid expression", LINK);
4086	/PrintUDIParam(i)/
4087	}
4088	}
4089	if (i != 0) {
4090	getest___(P_expset(SET, 1 << ((long)semicolon)),
4091	"<;> expected", LINK);
4092	GetSym___(LINK);
4093	}
4094	break;
4095	/4/
4096	default:
4097	break;
4098	}/3:of CASE/
4099
4100	} while (LINK->sym == (long)prnsym \|\| LINK->sym == (long)celsym \|\|
4101	LINK->sym == (long)dspsym \|\|
4102	LINK->sym == (long)chmsym \|\| LINK->sym == (long)ident);
4103	}
4104
4105	test___(P_addset(P_expset(SET5, 0), (long)endsym), "<END> expected", LINK);
4106	getest___(P_expset(SET, 1 << ((long)semicolon)), "<;> expexted", LINK);
4107
4108
4109
4110	/8888888888/
4111	/5/
4112	/6/
4113	/6/
4114	/5/
4115	/1/
4116	/1/
4117	} /0/
4118
4119
4120	void GetEnergy(struct LOC_Lattice_Read *LINK)
4121	{
4122	long k=0;
4123
4124	k = CheckUDItable("energy ", LINK);
4125	if (k == 0) {
4126	printf("> Beam energy is not defined.\n");
4127	printf(" Input beam energy in [GeV] := ");
4128	scanf("%lg%*[^\n]", &globval.Energy);
4129	getchar();
4130	EnterUDItable("energy ", globval.Energy, LINK);
4131	} else
4132	RefUDItable("energy ", &globval.Energy, LINK);
4133	}
4134
4135
4136	void GetRingType(struct LOC_Lattice_Read *LINK)
4137	{
4138	long k=0;
4139
4140	k = CheckUDItable("ringtype ", LINK);
4141	if (k == 0L) {
4142	fprintf(stdout,"> Ring type is not defined, default is ring.\n");
4143	globval.RingType = 1;
4144	} else {
4145	globval.RingType = (int) LINK->UDItable[k - 1L].Uvalue;
4146	if (globval.RingType != 1 && globval.RingType != 0) {
4147	printf("> ringtype variable is not defined"
4148	" properly in the lattice file\n");
4149	printf("> ringtype set to 1 means ring\n");
4150	printf("> ringtype set to 0 means transfer line\n");
4151	exit_(1);
4152	}
4153	}
4154	}
4155
4156
4157	/****************************************************************************/
4158	/* void GetDP(struct LOC_Lattice_Read *LINK)
4159
4160	Purpose:
4161	Define particle energy offset read from lattice file
4162
4163	Input:
4164	none
4165
4166	Output:
4167	none
4168
4169	Return:
4170	none
4171
4172	Global variables:
4173	none
4174
4175	Specific functions:
4176	none
4177
4178	Comments:
4179	none
4180
4181	****************************************************************************/
4182	static void GetDP(struct LOC_Lattice_Read *LINK)
4183	{
4184	long k;
4185
4186	k = CheckUDItable("dp ", LINK);
4187	if (k != 0) {
4188	RefUDItable("dp ", &globval.dPcommon, LINK);
4189	return;
4190	}
4191	printf("> dP/P is not defined.\n");
4192	printf(" Input dP/P := ");
4193	scanf("%lg%*[^\n]", &globval.dPcommon);
4194	getchar();
4195	EnterUDItable("dp ", globval.dPcommon, LINK);
4196	}
4197
4198	/****************************************************************************/
4199	/* void GetCODEPS(LOC_Lattice_Read *LINK)
4200
4201	Purpose:
4202	Read and assign cod precision read from lattice file
4203
4204	Input:
4205	none
4206
4207	Output:
4208	none
4209
4210	Return:
4211	none
4212
4213	Global variables:
4214	none
4215
4216	Specific functions:
4217	none
4218
4219	Comments:
4220	none
4221
4222	****************************************************************************/
4223	static void GetCODEPS(struct LOC_Lattice_Read *LINK)
4224	{
4225	long k;
4226
4227	k = CheckUDItable("codeps ", LINK);
4228	if (k != 0) {
4229	RefUDItable("codeps ", &globval.CODeps, LINK);
4230	return;
4231	}
4232	printf("> CODEPS is not defined.\n");
4233	printf(" Input CODEPS := ");
4234	scanf("%lg%*[^\n]", &globval.CODeps);
4235	getchar();
4236	EnterUDItable("codeps ", globval.Energy, LINK);
4237	}
4238
4239	/****************************************************************************/
4240	/* Local double Circumference(struct LOC_Lattice_Read *LINK)
4241
4242	Purpose:
4243
4244
4245	Input:
4246	none
4247
4248	Output:
4249	none
4250
4251	Return:
4252	none
4253
4254	Global variables:
4255	none
4256
4257	Specific functions:
4258	none
4259
4260	Comments:
4261	none
4262
4263	****************************************************************************/
4264	static double Circumference(struct LOC_Lattice_Read *LINK)
4265	{
4266	long i;
4267	double S;
4268	long FORLIM;
4269
4270	S = 0.0;
4271	FORLIM = globval.Cell_nLoc;
4272	for (i = 1; i <= FORLIM; i++)
4273	S += ElemFam[Cell[i].Fnum - 1].ElemF.PL;
4274	return S;
4275	}
4276
4277
4278	/****************************************************************************/
4279	/* Local void RegisterKids(struct LOC_Lattice_Read *LINK)
4280
4281	Purpose:
4282
4283
4284	Input:
4285	none
4286
4287	Output:
4288	none
4289
4290	Return:
4291	none
4292
4293	Global variables:
4294	none
4295
4296	Specific functions:
4297	none
4298
4299	Comments:
4300	none
4301	****************************************************************************/
4302
4303	static void RegisterKids(struct LOC_Lattice_Read *LINK)
4304	{
4305	long i, FORLIM;
4306	ElemFamType *WITH;
4307
4308	if (globval.Elem_nFam <= Elem_nFamMax) {
4309	FORLIM = globval.Elem_nFam;
4310	for (i = 0; i < FORLIM; i++)
4311	ElemFam[i].nKid = 0;
4312	} else {
4313	printf("Elem_nFamMax exceeded: %ld(%d)\n",
4314	globval.Elem_nFam, Elem_nFamMax);
4315	exit_(1);
4316	}
4317
4318	FORLIM = globval.Cell_nLoc;
4319	for (i = 1; i <= FORLIM; i++) {
4320	WITH = &ElemFam[Cell[i].Fnum - 1];
4321	WITH->nKid++;
4322	if (WITH->nKid <= nKidMax) {
4323	WITH->KidList[WITH->nKid - 1] = i;
4324	Cell[i].Knum = WITH->nKid;
4325	} else
4326	printf("nKidMax exceeded: %d(%d)\n", WITH->nKid, nKidMax);
4327	}
4328	}
4329
4330
4331	/****************************************************************************/
4332	/* void PrintResult(struct LOC_Lattice_Read *LINK)
4333
4334	Purpose:
4335	Print Lattice statistics
4336
4337	input:
4338	LINK
4339
4340	output:
4341	none
4342
4343	return:
4344	none
4345
4346	global variables:
4347	none
4348
4349	specific functions:
4350	none
4351
4352	comments
4353	none
4354
4355	****************************************************************************/
4356	void PrintResult(struct LOC_Lattice_Read *LINK)
4357	{
4358	long j, nKid, FORLIM;
4359	struct tm *newtime;
4360
4361	/* Get time and date */
4362	newtime = GetTime();
4363
4364	printf("\n");
4365	printf(" TRACY III v. 3.5 compiled on %s\n",__DATE__);
4366	printf("\n");
4367	printf(" LATTICE Statistics for today %s \n\n", asctime2(newtime));
4368	printf(" Number of constants: UDIC =%5ld"
4369	", UDImax =%5d\n",
4370	LINK->UDIC, UDImax);
4371	printf(" Number of keywords : nkw =%5ld"
4372	", Lat_nkw_max =%5d\n",
4373	LINK->nkw, Lat_nkw_max);
4374	printf(" Number of Families : globval.Elem_nFam =%5ld"
4375	", Elem_nFamMax =%5d\n",
4376	globval.Elem_nFam, Elem_nFamMax);
4377	nKid = 0L;
4378	FORLIM = globval.Elem_nFam;
4379	for (j = 0L; j < FORLIM; j++) {
4380	if (ElemFam[j].nKid > nKid)
4381	nKid = ElemFam[j].nKid;
4382	}
4383	printf(" Max number of Kids : nKidMax =%5ld"
4384	", nKidMax =%5d\n",
4385	nKid, nKidMax);
4386	printf(" Number of Blocks : NoB =%5ld"
4387	", NoBmax =%5d\n",
4388	LINK->NoB, NoBmax);
4389	printf(" Max Block size : NoBE =%5ld"
4390	", NoBEmax =%5d\n",
4391	LINK->Bpointer, NoBEmax);
4392	printf(" Number of Elements : globval.Cell_nLoc =%5ld"
4393	", Cell_nLocmax =%5d\n",
4394	globval.Cell_nLoc, Cell_nLocMax);
4395	printf(" Circumference : %12.7f [m]\n", Circumference(LINK));
4396	printf("\n");
4397	printf("\n");
4398	}
4399
4400	/****************************************************************************/
4401	/* long ElemIndex(const char *name)
4402
4403	Purpose:
4404	return family index of the element .
4405	Note: in the PASCAL version the element family index could be
4406	comfortably accessed using the element name.
4407	This is no longer possible because we gave up on the interpretive PASCAL-S.
4408	Input:
4409	name Family name
4410
4411	Output:
4412	none
4413
4414	Return:
4415	none
4416
4417	Global variables:
4418	none
4419
4420	Specific functions:
4421	none
4422
4423	Comments:
4424	30-06-2011 Fix the bug to get the correct Cell[i].Elem.PName.
4425	****************************************************************************/
4426
4427	long ElemIndex(const char *name)
4428	{
4429	long i = 0;
4430	int n = 0;
4431	partsName name1, name2;
4432
4433
4434	const bool prt = false;
4435
4436	if (prt) printf("\n");
4437
4438	while(name[i]!= ' ' && name[i]!= '\0'){
4439	name1[i] = tolower(name[i]);
4440	i++;
4441	}
4442	name1[i] = '\0';
4443
4444
4445	if (globval.Elem_nFam > Elem_nFamMax) {
4446	printf("ElemIndex: Elem_nFamMax exceeded: %ld(%d)\n",
4447	globval.Elem_nFam, Elem_nFamMax);
4448	exit_(1);
4449	}
4450
4451	for (i = 1; i <= globval.Elem_nFam; i++)
4452	{
4453	n = 0;
4454	while ((ElemFam[i-1].ElemF.PName[n] != ' ') && (ElemFam[i-1].ElemF.PName[n] != '\0'))
4455	{
4456	name2[n] = ElemFam[i-1].ElemF.PName[n];
4457	n++;
4458	}
4459	name2[n] = '\0';
4460
4461	if (prt)
4462	printf("%d %d %s \|%s\|%s\|\n",
4463	n, strcmp(name2, name1) == 0, name1, ElemFam[i-1].ElemF.PName, name2);
4464	if (strcmp(name2, name1) == 0)
4465	return i;
4466	}
4467
4468	printf("ElemIndex: undefined element %s\n", name);
4469	exit_(1);
4470	return 0;
4471	}
4472
4473	/****************************************************************************/
4474	/* boolean Lattice_Read(FILE fi_, FILE fo_)
4475
4476	Purpose:
4477	Low level routine for reading lattice file
4478
4479	Input:
4480	none
4481
4482	Output:
4483	none
4484
4485	Return:
4486	none
4487
4488	Global variables:
4489	globval
4490
4491	Specific functions:
4492	setjmp f2c
4493	init_reserved_words
4494
4495	Comments:
4496	none
4497
4498	****************************************************************************/
4499
4500	bool Lattice_Read(FILE fi_, FILE fo_)
4501	{
4502	struct LOC_Lattice_Read V;
4503
4504	if (trace)
4505	printf("t2lat: dndsym = %d, solsym = %d, max_set = %d, SETBITS = %u\n",
4506	bndsym, solsym, max_set, (unsigned)(4*sizeof(long int)));
4507
4508	V.fi = fi_; /* input lattice file */
4509	V.fo = fo_; /* output lattice file */
4510	if (setjmp(V._JL9999))
4511	goto _L9999;
4512	V.UDIC = 0;
4513	globval.Cell_nLoc = 0;
4514	globval.Elem_nFam = 0;
4515	V.NoB = 0;
4516	V.Symmetry = 0;
4517	V.Bpointer = 0;
4518
4519	globval.CODeps = 0.0;
4520	globval.dPcommon = 0.0;
4521	globval.Energy = 0.0;
4522
4523	ErrFlag = false;
4524
4525	init_reserved_words(&V);
4526
4527	GetSym___(&V);
4528
4529	if (V.sym == defsym)
4530	DealWithDefns(&V);
4531
4532	if (V.Symmetry != 0)
4533	{
4534	GetRingType(&V);/* define whether a ring or a transfer line */
4535	GetEnergy(&V); /* define particle energy */
4536	GetCODEPS(&V); /* define COD precision */
4537	GetDP(&V); /* define energy offset */
4538	}
4539
4540	if (*V.fi != NULL)
4541	fclose(V.fi); / Close lat file */
4542	*V.fi = NULL;
4543	if (*V.fo != NULL)
4544	fclose(V.fo); / Close lax file */
4545	*V.fo = NULL;
4546	RegisterKids(&V); /* Check whether too many elements */
4547	PrintResult(&V); /* Print lattice statistics */
4548	_L9999:
4549	return (!ErrFlag);
4550	}
4551
4552	#undef NoBmax
4553	#undef NoBEmax
4554	#undef UDImax
4555	#undef LatLLng
4556	#undef Lat_nkw_max
4557	#undef emax
4558	#undef emin
4559	#undef kmax
4560	#undef nmax
4561
4562	#undef nn // added by nsrl-ii
4563	#undef tmax // added by nsrl-ii
4564
4565	#undef smax
4566	#undef xmax
4567

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: