c c subroutine process c c DATE OF FIRST VERSION: 21-jun-83 c c PURPOSE: Program to generate tek files from plt files in c Tektronix 4662 language. c c PROGRAMMER: Matt Prucka c c********************************************************************* c Parameter types defined here logical*1err real*4x(512),y(512),z(512) integercmdtyp byteinstr(80) externallen 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 c c Names and default values for PLT parameters c c COMMON /PARAMS/ c X-axis parameters data xmin / 0.0/, prmnam( 1) /'XMIN '/ data xmax / 10.0/, prmnam( 2) /'XMAX '/ data xint / 5.0/, prmnam( 3) /'XINT '/ data xcycle / 0.0/, prmnam( 4) /'XCYCLE '/ data xpct /100.0/, prmnam( 5) /'XPERCENT'/ data xlen / 6.0/, prmnam( 6) /'XLEN '/ data xllc / 2.2/, prmnam( 7) /'XLLC '/ c Y-axis parameters data ymin / 0.0/, prmnam( 8) /'YMIN '/ data ymax / 10.0/, prmnam( 9) /'YMAX '/ data yint / 5.0/, prmnam(10) /'YINT '/ data ycycle / 0.0/, prmnam(11) /'YCYCLE '/ data ypct /100.0/, prmnam(12) /'YPERCENT'/ data ylen / 6.0/, prmnam(13) /'YLEN '/ data yllc / 1.5/, prmnam(14) /'YLLC '/ c Right-hand axis parameters data rmin / 0.0/, prmnam(15) /'RMIN '/ data rmax / 0.0/, prmnam(16) /'RMAX '/ data rint / 0.0/, prmnam(17) /'RINT '/ data rcycle / 0.0/, prmnam(18) /'RCYCLE '/ data rpct /100.0/, prmnam(19) /'RPERCENT'/ c Parameters for plotted data data pltype / 3.0/, prmnam(20) /'PLTYPE '/ data typlin / 0.0/, prmnam(21) /'LINTYPE '/ data pltlin / -1.0/, prmnam(22) /'PLTLWT '/ data symnum / 1.0/, prmnam(23) /'SYMBOL '/ data sizsym / 1.0/, prmnam(24) /'SYMSIZ '/ data solid / 0.0/, prmnam(25) /'SOLID '/ c Parameters for annotations data sizann / 1.0/, prmnam(26) /'ANNSIZ '/ data wtlnan / -1.0/, prmnam(27) /'ANNLWT '/ data xanlab / 0.0/, prmnam(28) /'XANSKP '/ data yanlab / 0.0/, prmnam(29) /'YANSKP '/ data ranlab / 0.0/, prmnam(30) /'RANSKP '/ data yhor / 0.0/, prmnam(31) /'YHOR '/ c Miscellaneous parameters data grid / 0.0/, prmnam(32) /'GRID '/ data sizlab / 1.0/, prmnam(33) /'LABSIZ '/ data wtlnlb / -1.0/, prmnam(34) /'LABLWT '/ data ticmrk / 0.0/, prmnam(35) /'TICDIR '/ data shade / 0.0/, prmnam(36) /'SHADE '/ data echo / 0.0/, prmnam(37) /'ECHO '/ data wtlnax / -1.0/, prmnam(38) /'AXLWT '/ data openax / 0.0/, prmnam(39) /'OPENAX '/ c Parameters for messages data sizmsg / 1.0/, prmnam(40) /'MSGSIZ '/ data wtlnms / -1.0/, prmnam(41) /'MSGLWT '/ data xmsg / 0.0/, prmnam(42) /'MXLLC '/ data ymsg / 0.0/, prmnam(43) /'MYLLC '/ data angmsg / 0.0/, prmnam(44) /'MSGANGLE'/ data datmsg / 0.0/, prmnam(45) /'MSGDAT '/ c Other parameters data sizfac / 0.0/, prmnam(46) /'SIZFAC '/ data smooth / 0.0/, prmnam(47) /'SMOOTH '/ data header / 1.0/, prmnam(48) /'HEADER '/ data sort / 1.0/, prmnam(49) /'SORT '/ c Parameters reserved for future use data unused(1) / 0.0/, prmnam(50) /'UNUSED '/ c COMMON /FLAGS/ data dataon /.false./ data pltfnd /.false./ data msgflg /.false./ data finflg /.false./ data modflg /.false./ data conton /.false./ data axflg /.true. / data newpag /.true. / data ecflg /.false./ data typerr /.true. / c COMMON /NAMES/ (except for PRMNAM) c Text parameter names data txtnam(1) /'XFMT '/ data txtnam(2) /'YFMT '/ data txtnam(3) /'RFMT '/ data txtnam(4) /'XLABEL '/ data txtnam(5) /'YLABEL '/ data txtnam(6) /'RLABEL '/ c Key words data keywrd( 1) /'PLOT '/ data keywrd( 2) /'DATLIST '/ data keywrd( 3) /'READPAG '/ data keywrd( 4) /'DATA '/ data keywrd( 5) /'DELETE '/ data keywrd( 6) /'MODIFY '/ data keywrd( 7) /'FINISH '/ data keywrd( 8) /'DISPLAY '/ data keywrd( 9) /'HELP '/ data keywrd(10) /'NEWPAGE '/ data keywrd(11) /'NEWFRAME'/ data keywrd(12) /'PRMLIST '/ data keywrd(13) /'INCLUDE '/ data keywrd(14) /'CALL '/ data keywrd(15) /'RUN '/ data keywrd(16) /'UNUSED '/ data keywrd(17) /'UNUSED '/ data keywrd(18) /'UNUSED '/ data keywrd(19) /'UNUSED '/ data keywrd(20) /'UNUSED '/ data keywrd(21) /'UNUSED '/ data keywrd(22) /'UNUSED '/ data keywrd(23) /'UNUSED '/ data keywrd(24) /'UNUSED '/ data keywrd(25) /'UNUSED '/ c COMMON /TEXT/ (other entries in this block don't need to be initialized) data xfmt /'I','3',4*0/ data yfmt /'I','3',4*0/ data rfmt /'I','3',4*0/ c COMMONS /MISC/, /SIZE/, and /AXES/ don't need to be initialized c c COMMON /MSKS/ c data msk1/"37/,msk2/"177740/,msk3/"3777/ data msk4/"377/,msk5/"177400/ 1 format (' Invalid Command: ',79a1) 2 format (' *** Data Buffer Full ***') c c Do the plot by reading input lines and processing them c inow = 1 c while 23000 if(.not.(inow .le. ito))goto 23001 ecflg=(echo.eq.1.) cmdtyp = nxtlin (instr) c Data value if(.not.(cmdtyp .eq. 1))goto 23002 i = indata (x,y,z,ndatpt,512,instr) if(.not.(ndatpt .ge. 512))goto 23004 c Data buffer full: write (5,2) c plot call pltkey (1,x,y,z,instr,ndatpt) 23004 continue c Parameter alteration goto 23003 c else 23002 continue if(.not.(cmdtyp .eq. 3))goto 23006 call setprm (instr) c Message goto 23007 c else 23006 continue if(.not.(cmdtyp .eq. 4))goto 23008 call getmsg (instr) msgflg = .true. if(.not.(.not.axflg))goto 23010 c Do the message if c axes have been plotted call putmsg msgflg = .false. 23010 continue c End of file goto 23009 c else 23008 continue if(.not.(cmdtyp .eq. -1))goto 23012 if(.not.(lunin .ne. 3))goto 23014 c If from CALL/INCLUDE call cnglun goto 23015 c else 23014 continue c If it's the main file goto 23001 23015 continue c Keyword, maybe. Scan the keyword list. If it's valid, execute it. c If not, type an error message if the terminal is available. goto 23013 c else 23012 continue i = iscan (keywrd,25,instr) if(.not.(i .eq. 7))goto 23016 c If keyword = 'finish' goto 23001 c else 23016 continue if(.not.(i .gt. 0))goto 23018 c If it's a valid keyword call pltkey (i,x,y,z,instr,ndatpt) goto 23019 c else 23018 continue c If it's not a valid keyword write(5,1) (instr(i),i=1,len(instr)) 23019 continue 23017 continue 23013 continue 23009 continue 23007 continue 23003 continue goto 23000 c endwhile 23001 continue c plot call pltkey (1,x,y,z,instr,ndatpt) c finish call pltkey (7,x,y,z,instr,ndatpt) call flush close(unit=lunout) return end