Subroutine Rpldat(Akeep) c *********************************************************************** c * * c * Subroutine RPLDAT - To read the current plot presentation * c * file used by PLOTFL. Routine reads files written by Wpldat. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Character*80 Dummy Character*84 Labelc Byte Labelb(84) Virtual Akeep(28,50) Equivalence (Labelc,Labelb) Integer Spchar,Atxclr,Xtop Common/Labs/Nlab Common/Ptype/Idev,Xtop,Spchar,Chscal c c Read presentation from file "PLTPRG.PLT" c Open(Unit=12,NAME='PLTPRG.PLT',Type='OLD') c Read(12,100) (Dummy,I=1,14) 100 Format(A) Read(12,*) NLab,Lachst,Ntxbl,Nleg,Lechst,Legtit,Labcrd,Iz c If (Nleg .GT. 0) Read(12,100) (Dummy,I=1,Nleg*2+1) c c Read in the text block data: c If (Ntxbl .NE. 0) Then Read(12,100) Dummy Do 30 I=1,Ntxbl c c Read the text block parameters c Read(12,*) Ntxl c c Read the text block label data c Read(12,100) (Dummy,J=1,Ntxl*2) 30 Continue End If c If (Nlab .GT. 0) Then c c Read the labels c Do 40 I=1,Nlab Read(12,*) Nchars,Xlabel,Ylabel, $ Size,Jlabel,Iprot,Irot If (Size .EQ. 1.0) Size = 1.7 If (Size .EQ. 2.0) Size = 2.3 Read(12,100) Labelc Call Load(Akeep,Labelc,I) Call Stccsz(Size*0.03*Chscal,Size*0.042*Chscal) Labelc(1:3) = '@@@' Labelb(4) = 48+Lachst Call Unload(Akeep,Labelc(5:5),I) Call Gtstln(Nchars+4,Labelb,Xlen) Call Vload(Akeep,I,Xlabel,Ylabel,Xlen,Size,Nchars,Jlabel, $ Iprot,Irot) 40 Continue End If c c Finished reading the presentation data c Close(Unit=12) c Return End Subroutine Enderi(Akeep) c *********************************************************************** c * * c * Subroutine ENDERI - To finish up a plot, & restart PLTPRG. * c * * c * Programmed By Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Virtual Akeep(28,50) c Write(7,200) 27,7,27 200 Format(1X,A1,'[HDo you want to keep the changes? (y/n) ',2A1, $ '[K',$) Call Instrg('YyNn',4,Iyn) c Call Plton Call Scfini Call Pltclr Close(Unit=7) Close(Unit=5) If (Iyn .LT. 3) Call Wpldat(Akeep) c c Sound the bell c Write(7,100) 7,7 100 Format(1X,2A1) c Call Setcmd('Run Dp:Pltprg') Call Exit c End Subroutine Ender c c *********************************************************************** c * * c * Subroutine ENDER - To execute command * c * files to send plots to the HP plotter and LA 50 printer, * c * and then restart "PLTPRG". * c * * c * Programmed By Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Character*80 Line,Bytt*1 Character*2 Lines Byte Lineno(2) Equivalence (Lines,Lineno) Integer Spchar,Xtop Byte Byt Equivalence (Bytt,Byt) c Common/Ptype/Idev,Xtop,Spchar,Chscal,Chsc1 Common/Pltfil/Lineno,Iterm Common/Ends/Ireset,Icflag,Iout c c Read & write any terminal reset info c If (Ireset .GT. 0) Then If (Iterm .EQ. 1) Then Call Scfini Write(5,100) 7,7 Read(5,200) I End If c Do 20 I=1,Ireset 10 Continue Read(14,300) Line 300 Format(A) If (Line(1:1) .EQ. '!') Go To 10 Write(Iout,400) Line 400 Format(1X,A) 20 Continue If (Iterm .EQ. 0) Then Write(5,100) 7,7 Close(Unit=Iout) End If Else Call Scfini c c Sound the bell when done c Write(5,100) 7,7 100 Format(1X,2A1) c c Pause if the output device was a terminal c If (Iterm .EQ. 1) Then Read(5,200) I 200 Format(1A1) End If End If c c Read a command file name if requested c If (Icflag .GE. 1) Then 30 Continue Read(14,500) Nchars,Line 500 Format(Q,A) If (Line(1:1) .EQ. '!') Go To 30 Line(Nchars+1:Nchars+1) = ' ' Line(Nchars+2:Nchars+3) = Lines Line(Nchars+4:Nchars+4) = Bytt Close(Unit=14) Call Setcmd(Line) Call Exit End If Close(Unit=14) c Call Exit c End Subroutine Wpldat(Akeep) c *********************************************************************** c * * c * Subroutine WPLDAT - To write the new plot presentation * c * file after the labels have been modified. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Character*80 Dummy Virtual Akeep(28,50) Common/Labs/Nlab Common/Legmov/Xorig,Yorig,Xlegln,Ylegln,Lesize,Legcnr,Leglin, $ Gblspc Common/Txplot/Xtxorg(10),Ytxorg(10),Xtlen(10),Ytlen(10), $ Loctx(10),Txszrt(10),Txspac(10),Txlen(10) c c Read presentation from file "PLTPRG.PLT" c Open(Unit=12,Name='PLTPRG.PLT',Type='OLD') Open(Unit=14,Name='PLTPRG.TMP',Type='NEW') c Do 10 I=1,14 Read(12,100) Nch,Dummy Write(14,200) Dummy(1:Nch) 100 Format(Q,A) 200 Format(A) 10 Continue c Read(12,*) Nlabod,Lachst,Ntxbl,Nleg,Lechst,Legtit, $ Labcrd,Iz Write(14,300) Nlab,Lachst,Ntxbl,Nleg,Lechst,Legtit, $ Labcrd,Iz 300 Format(8I5) c If (Nleg .GT. 0) Then Read(12,*) Xleg,Yleg,Locleg,Ibxleg,Sizlgs,Legsz,Idummy,Gb Call Sizleg(Xorig,Yorig,Legcnr,Xlegln,Ylegln,0.0) Write(14,325) Xorig,Yorig,Legcnr,Ibxleg,Lesize,Legsz, $ Idummy,Gblspc 325 Format(2F19.7,5I5,G12.5) Do 20 I=1,Nleg*2 Read(12,100) Nch,Dummy Write(14,200) Dummy(1:Nch) 20 Continue End If c c Read in the text block data: c If (Ntxbl .NE. 0) Then Read(12,100) Nch,Dummy Write(14,200) Dummy(1:Nch) Do 30 I=1,Ntxbl c c Read the text block parameters c Read(12,*) Ntxl,Txtblx,Txtbly, $ Itblch,Itblcl,Txbloc,Itbord,Txblsp Call SizLeg(Xtxorg(I),Ytxorg(I),Loctx(I),Xtlen(I), $ Ytlen(I),0.0) Write(14,350) Ntxl,Xtxorg(I),Ytxorg(I),Itblch,Itblcl, $ Loctx(I),Itbord,Txspac(I) 350 Format(I5,2G19.7,4I5,F12.5) Do 25 J=1,Ntxl*2 Read(12,100) Nch,Dummy Write(14,200) Dummy(1:Nch) 25 Continue 30 Continue End If c If (Nlab .GT. 0) Then c c Read the labels c Do 40 I=1,Nlab Call Vunlod(Akeep,I,Xlabel,Ylabel,Xlen,Size,Nchars,Jlabel, $ Iprot,Irot) Write(14,400) Nchars,Xlabel,Ylabel, $ Int(Size),Jlabel,Iprot,Irot 400 Format(I5,2E19.7,4I5) Call Unload(Akeep,Dummy,I) Write(14,200) Dummy(1:Nchars) 40 Continue End If c c Read up the old labels c Do 45 I=1,Nlabod*2 Read(12,100) Nch,Dummy 45 Continue c c Write the plot curve information c 50 Continue Read(12,100,END=60,ERR=60) Nch,Dummy Write(14,200) Dummy(1:Nch) Go To 50 c 60 Continue c c Finished reading the presentation data c Close(Unit=12) Close(Unit=14) c Call Rename Return End