c subroutine pltcml (iecho,imodel) c c PROG NAME: PLTCML.rat c c DATE OF FIRST VERSION: 21-Jun083 c c PURPOSE: To parse the PLT command line. The input file c name is given the extension .PLT if necessary. c The swiches /EC, /FR:M, /TO:N, /HO, /VE, /TK c /PP, and /TT are examined and values returned. c c USAGE: CALL PLTCML (IECHO,IMODEL) c c where c IECHO -- set to 1 if /EC, 0 if /-EC (default) c IMODEL -- set to 0 if no output device specified c 1 if /HO c 2 if /VE c 3 if /TK c 4 if /PP c 5 if /TT c 6 if /TP c c in PLTBLK, c c FILNAM -- receives name of input file c IFROM -- set to M if /FR:M found c ITO -- set to N if /TO:N found c c PROGRAMMER: Matt Prucka c c******************************************************************** c c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 byteauxfil(40),prompt(11),upcase,c0,c1,c2,c3 logical*1comand,succes integer outfil data filonm/'p','l','t','.','t','e','k',0,0,0,0,0,0,0/ data prompt/'p','l','t',' ','f','i','l','e','?',' ',128/ c c-------------------------------------------------------------------- c iecho=0 imodel=0 outfil=0 dbflg=.false. call gtlin(auxfil,prompt) c for i=1 23000 if(.not.(i.le.38))goto 23002 if(.not.(auxfil(i).eq.'='))goto 23003 outfil=1 23003 continue i=i+1 goto 23000 c endfor 23002 continue i=1 if(.not.(outfil.eq.1))goto 23005 c while 23007 if(.not.(auxfil(i).ne.'='))goto 23008 filonm(i)=auxfil(i) i=i+1 goto 23007 c endwhile 23008 continue filonm(i)=0 i=i+1 23005 continue j=1 c while 23009 if(.not.(auxfil(i).ne.'/'.and.auxfil(i).ne.0))goto 23010 filinm(j)=auxfil(i) j=j+1 i=i+1 goto 23009 c endwhile 23010 continue filinm(j)=0 c while 23011 if(.not.(auxfil(i).eq.'/'))goto 23012 if(.not.(auxfil(i+1).eq.'-'))goto 23013 i=i+1 23013 continue c0=upcase(auxfil(i)) c1=upcase(auxfil(i+1)) c2=upcase(auxfil(i+2)) c3=upcase(auxfil(i+3)) if(.not.(c0.eq.'-'.and.c1.eq.'E'.and.c2.eq.'C'))goto 23015 iecho=0 goto 23016 c else 23015 continue if(.not.(c1.eq.'E'.and.c2.eq.'C'))goto 23017 iecho=1 goto 23018 c else 23017 continue if(.not.(c1.eq.'H'.and.c2.eq.'O'))goto 23019 imodel=1 goto 23020 c else 23019 continue if(.not.(c1.eq.'V'.and.c2.eq.'E'))goto 23021 imodel=2 goto 23022 c else 23021 continue if(.not.(c1.eq.'T'.and.c2.eq.'K'))goto 23023 imodel=3 goto 23024 c else 23023 continue if(.not.(c1.eq.'P'.and.c2.eq.'P'))goto 23025 imodel=4 goto 23026 c else 23025 continue if(.not.(c1.eq.'T'.and.c2.eq.'T'))goto 23027 imodel=5 goto 23028 c else 23027 continue if(.not.(c1.eq.'T'.and.c2.eq.'P'))goto 230 & 29 imodel=6 goto 23030 c else 23029 continue if(.not.(c1.eq.'F'.and.c2.eq.'R'.and. & c3.eq.':'))goto 23031 call getint(auxfil(i+4),int,n) iform=int i=i+n goto 23032 c else 23031 continue if(.not.(c1.eq.'T'.and.c2.eq.'O' & .and.c3.eq.':'))goto 23033 call getint(auxfil(i+4),int,n) ito=int i=i+n goto 23034 c else 23033 continue if(.not.(c1.eq.'D'.and.c2.eq.'B')) & goto 23035 dbflg=.true. goto 23036 c else 23035 continue type 201,c0,c1,c2,c3 call exit 23036 continue 23034 continue 23032 continue 23030 continue 23028 continue 23026 continue 23024 continue 23022 continue 23020 continue 23018 continue 23016 continue i=i+3 goto 23011 c endwhile 23012 continue if(.not.(auxfil(i).ne.0))goto 23037 type 201,(auxfil(j),j=i,40) call exit 23037 continue call ckfiln(filinm) if(.not.(outfil.eq.1))goto 23039 call ckfiln(filonm) 23039 continue return 201 format(' *** error illegal switch: ',40a1) end c ckfiln subroutine ckfiln(filnam) byte filnam(1),auxfil(16),defext(4),upcase data defext/'.','P','L','T'/ j=1 c for i=1 23041 if(.not.(filnam(i).ne.'.'.and.filnam(i).ne.0))goto 23043 if(.not.(j.le.10))goto 23044 auxfil(j)=filnam(i) j=j+1 23044 continue i=i+1 goto 23041 c endfor 23043 continue if(.not.(filnam(i).eq.'.'))goto 23046 c for k=0 23048 if(.not.(k.lt.4))goto 23050 auxfil(j+k)=filnam(i+k) k=k+1 goto 23048 c endfor 23050 continue goto 23047 c else 23046 continue c for k=0 23051 if(.not.(k.lt.4))goto 23053 auxfil(j+k)=defext(1+k) k=k+1 goto 23051 c endfor 23053 continue 23047 continue c for i=1 23054 if(.not.(i.le.j+3))goto 23056 filnam(i)=upcase(auxfil(i)) i=i+1 goto 23054 c endfor 23056 continue filnam(i)=0 return end c getint subroutine getint(str,int,n) byte str(1) int=0 c for n=1 23057 if(.not.(str(n).ge.'0'.and.str(n).le.'9'))goto 23059 int=int*10+str(n)-"60 n=n+1 goto 23057 c endfor 23059 continue return end c upcase byte function upcase(char) byte char if(.not.(char.ge.'a' .and. char.le.'z'))goto 23060 upcase=(char-'a')+'A' .and. "177 goto 23061 c else 23060 continue upcase=char .and. "177 23061 continue return end