[12] | 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) |
---|
[18] | 29 | |
---|
[12] | 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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
---|