1 | cbm subroutine cread(jj) |
---|
2 | subroutine cread |
---|
3 | c-------------------------------------------------------------------------- |
---|
4 | save |
---|
5 | c |
---|
6 | include 'param_sz.h' |
---|
7 | include 'var_char.h' |
---|
8 | include 'misccom.h' |
---|
9 | include 'ucom.h' |
---|
10 | c |
---|
11 | common/image/jj,ij |
---|
12 | c* |
---|
13 | c-------------------------------------------------------------------------- |
---|
14 | data (bcd(j),j=1,nelem) / |
---|
15 | 1 'drift','solenoid','quad','bend','buncher', |
---|
16 | 2 'chopper','cell','tank','trwave','coil','run','input','output', |
---|
17 | 3 'title','scheff','zout','adjust','start','restart','continue', |
---|
18 | 4 'save','end','zlimit','errors','change','rotate','sbload', |
---|
19 | 5 'cfield','dpout','cathode','design','pipe','foclal','backb', |
---|
20 | 6 'wiggler','alpham','stat','poisson','sextupole'/ |
---|
21 | data (efg(j),j=1,nelem) / |
---|
22 | 1 'DRIFT','SOLENOID','QUAD','BEND','BUNCHER', |
---|
23 | 2 'CHOPPER','CELL','TANK','TRWAVE','COIL','RUN','INPUT','OUTPUT', |
---|
24 | 3 'TITLE','SCHEFF','ZOUT','ADJUST','START','RESTART','CONTINUE', |
---|
25 | 4 'SAVE','END','ZLIMIT','ERRORS','CHANGE','ROTATE','SBLOAD', |
---|
26 | 5 'CFIELD','DPOUT','CATHODE','DESIGN','PIPE','FOCLAL','BACKB', |
---|
27 | 6 'WIGGLER','ALPHAM','STAT','POISSON','SEXTUPOLE'/ |
---|
28 | data lfnr,nextr/0,1/ ! lfnr look for next run (or end) |
---|
29 | |
---|
30 | if (jj.eq.100) lfnr=1 |
---|
31 | 10 continue |
---|
32 | if (nextr.eq.0) go to 20 |
---|
33 | c read new data card |
---|
34 | nn=0 |
---|
35 | write(nnout,*) ' ' |
---|
36 | call card (ip,nl,nr,vv) |
---|
37 | go to 40 |
---|
38 | c shift data in vv |
---|
39 | 20 continue |
---|
40 | nextr=1 |
---|
41 | if(ip.ne.0) write(nnout,11) |
---|
42 | 11 format(1x) |
---|
43 | do 30 i=1,nr |
---|
44 | vv(i)=vv(i+nn) |
---|
45 | 30 continue |
---|
46 | nn=0 |
---|
47 | 40 continue |
---|
48 | if (nl.gt.0) go to 50 |
---|
49 | if (lfnr) 100,100,10 |
---|
50 | c process label |
---|
51 | 50 continue |
---|
52 | if (nl.gt.10) nl=10 |
---|
53 | write(abc,130)(ij(i),i=1,nl) |
---|
54 | c lukup abc in bcd(jj) to determine jj. |
---|
55 | do 60 jjj=1,nelem |
---|
56 | jj=jjj |
---|
57 | if (abc.eq.bcd(jj)) go to 70 |
---|
58 | if (abc.eq.efg(jj)) go to 70 |
---|
59 | 60 continue |
---|
60 | jj=0 |
---|
61 | go to 110 |
---|
62 | c lfnr = look for next run (or end). |
---|
63 | 70 continue |
---|
64 | write(*,*) ' >>> CREAD: card being processed: ',bcd(jj) |
---|
65 | if (jj.eq.12) then |
---|
66 | endif |
---|
67 | if (jj.eq.22) go to 90 ! end |
---|
68 | if (jj.eq.10) go to 95 ! coil |
---|
69 | if (jj.eq.11) lfnr=0 |
---|
70 | if (jj.eq.14) go to 90 ! title |
---|
71 | if (jj.eq.17) go to 95 |
---|
72 | if (jj.eq.28) go to 95 |
---|
73 | if (jj.eq.33) go to 95 |
---|
74 | if (jj.eq.34) go to 95 |
---|
75 | if (jj.eq.37) go to 91 ! stat |
---|
76 | if (jj.eq.38) go to 95 ! poisson |
---|
77 | if (jj.eq.40) go to 95 ! pt champ B |
---|
78 | if (lfnr.eq.0) go to 80 |
---|
79 | write(nnout, 150) bcd(jj) |
---|
80 | go to 10 |
---|
81 | c check for continuation of data |
---|
82 | 80 continue |
---|
83 | nn=nn+nr |
---|
84 | call card (ip,nl,nr,vv(nn+1)) |
---|
85 | if((nn+nr).gt.100) go to 120 |
---|
86 | if (nl.le.0) go to 80 |
---|
87 | c data from next card in ij and vv(nn+1) |
---|
88 | nextr=0 |
---|
89 | if(jj.ne.11) go to 90 |
---|
90 | c process run card |
---|
91 | if(vv(1).ne.0.) irun=vv(1) |
---|
92 | call ddate |
---|
93 | ip=vv(2) |
---|
94 | 90 continue |
---|
95 | return |
---|
96 | 91 continue |
---|
97 | return |
---|
98 | 95 continue |
---|
99 | nn=nr |
---|
100 | return |
---|
101 | c data error messages. |
---|
102 | 100 write(nnout, 160) |
---|
103 | lfnr=1 |
---|
104 | go to 10 |
---|
105 | 110 write(nnout, 170) abc |
---|
106 | write(nnout,*) abc |
---|
107 | lfnr=1 |
---|
108 | go to 10 |
---|
109 | 120 write(nnout, 180) abc |
---|
110 | lfnr=1 |
---|
111 | go to 10 |
---|
112 | c format section. |
---|
113 | c |
---|
114 | 130 format (10a1) |
---|
115 | 140 format (///' parmela program v4 ',a8, |
---|
116 | 1 5x,a10,/, |
---|
117 | 2 ' freq=',f9.2,' mhz, z0=',f6.1,' cm, w0=',g12.3,' MeV'/) |
---|
118 | 150 format (/4x,a6,2x,5e12.4/(4x,6e12.4)) |
---|
119 | 160 format (10x,32hdata error - - no label on card.) |
---|
120 | 170 format (10x,30hdata error - - cant find word.,10x,a8) |
---|
121 | 180 format (10x,32hdata error - - too many numbers.,10x,a8) |
---|
122 | end |
---|
123 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
---|