cbm subroutine cread(jj) subroutine cread c-------------------------------------------------------------------------- save c include 'param_sz.h' include 'var_char.h' include 'misccom.h' include 'ucom.h' c common/image/jj,ij c* c-------------------------------------------------------------------------- data (bcd(j),j=1,nelem) / 1 'drift','solenoid','quad','bend','buncher', 2 'chopper','cell','tank','trwave','coil','run','input','output', 3 'title','scheff','zout','adjust','start','restart','continue', 4 'save','end','zlimit','errors','change','rotate','sbload', 5 'cfield','dpout','cathode','design','pipe','foclal','backb', 6 'wiggler','alpham','stat','poisson','sextupole'/ data (efg(j),j=1,nelem) / 1 'DRIFT','SOLENOID','QUAD','BEND','BUNCHER', 2 'CHOPPER','CELL','TANK','TRWAVE','COIL','RUN','INPUT','OUTPUT', 3 'TITLE','SCHEFF','ZOUT','ADJUST','START','RESTART','CONTINUE', 4 'SAVE','END','ZLIMIT','ERRORS','CHANGE','ROTATE','SBLOAD', 5 'CFIELD','DPOUT','CATHODE','DESIGN','PIPE','FOCLAL','BACKB', 6 'WIGGLER','ALPHAM','STAT','POISSON','SEXTUPOLE'/ data lfnr,nextr/0,1/ ! lfnr look for next run (or end) if (jj.eq.100) lfnr=1 10 continue if (nextr.eq.0) go to 20 c read new data card nn=0 write(nnout,*) ' ' call card (ip,nl,nr,vv) go to 40 c shift data in vv 20 continue nextr=1 if(ip.ne.0) write(nnout,11) 11 format(1x) do 30 i=1,nr vv(i)=vv(i+nn) 30 continue nn=0 40 continue if (nl.gt.0) go to 50 if (lfnr) 100,100,10 c process label 50 continue if (nl.gt.10) nl=10 write(abc,130)(ij(i),i=1,nl) c lukup abc in bcd(jj) to determine jj. do 60 jjj=1,nelem jj=jjj if (abc.eq.bcd(jj)) go to 70 if (abc.eq.efg(jj)) go to 70 60 continue jj=0 go to 110 c lfnr = look for next run (or end). 70 continue write(*,*) ' >>> CREAD: card being processed: ',bcd(jj) if (jj.eq.12) then endif if (jj.eq.22) go to 90 ! end if (jj.eq.10) go to 95 ! coil if (jj.eq.11) lfnr=0 if (jj.eq.14) go to 90 ! title if (jj.eq.17) go to 95 if (jj.eq.28) go to 95 if (jj.eq.33) go to 95 if (jj.eq.34) go to 95 if (jj.eq.37) go to 91 ! stat if (jj.eq.38) go to 95 ! poisson if (jj.eq.40) go to 95 ! pt champ B if (lfnr.eq.0) go to 80 write(nnout, 150) bcd(jj) go to 10 c check for continuation of data 80 continue nn=nn+nr call card (ip,nl,nr,vv(nn+1)) if((nn+nr).gt.100) go to 120 if (nl.le.0) go to 80 c data from next card in ij and vv(nn+1) nextr=0 if(jj.ne.11) go to 90 c process run card if(vv(1).ne.0.) irun=vv(1) call ddate ip=vv(2) 90 continue return 91 continue return 95 continue nn=nr return c data error messages. 100 write(nnout, 160) lfnr=1 go to 10 110 write(nnout, 170) abc write(nnout,*) abc lfnr=1 go to 10 120 write(nnout, 180) abc lfnr=1 go to 10 c format section. c 130 format (10a1) 140 format (///' parmela program v4 ',a8, 1 5x,a10,/, 2 ' freq=',f9.2,' mhz, z0=',f6.1,' cm, w0=',g12.3,' MeV'/) 150 format (/4x,a6,2x,5e12.4/(4x,6e12.4)) 160 format (10x,32hdata error - - no label on card.) 170 format (10x,30hdata error - - cant find word.,10x,a8) 180 format (10x,32hdata error - - too many numbers.,10x,a8) end c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*