Subroutine WPLDAT(Data,Iflag,Jflag) c c *********************************************************************** c * * c * Subroutine WPLDAT - To write the current plot presentation * c * to a file, to be plotted by PLOTFL. Similar to SAVPLT * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cplot' Include 'Caxis' Include 'Clabls' Include 'Ctxblk' Include 'Clegnd' Include 'Cgrid' Include 'Cdefl' Include 'Cplsiz' c Virtual Data(1) c Iflag = 0 c c Compute the size (height) of the plot c c Start writing the plot parameters c Write(12,*,ERR=99) Xlen,Ylen,Textsz,Axchst,Axthik, $ Spchar Write(12,*,ERR=99) Xlmin,Xlmax,Ylmin,Ylmax 110 Format(2F10.5,2I4,F10.7,I4,2G13.5) Write(12,350,ERR=99) Xnumbr,Ynumbr,Axtypx,Axtypy, $ Ticdir,Atxclr Write(12,400,ERR=99) Xmin,Xmax,Xinc Write(12,400,ERR=99) Ymin,Ymax,Yinc Write(12,400,ERR=99) Xgrdmj,Xgrdmr,Ygrdmj,Ygrdmr Write(12,120,ERR=99) Thikmj,Thikmr,Grdcmj,Grdcmr 120 Format(2G13.5,2I4) Izero = 0 Write(12,350,ERR=99) Xtop,Axcolr,Lecolr,Lacolr Write(12,400,ERR=99) Delx,Dely,Space c c Save the axis titles c Write(12,100,ERR=99) (Xaxis(1,J),J=1,80) Write(12,100,ERR=99) (Xaxis(2,J),J=1,80) Write(12,100,ERR=99) (Yaxis(1,J),J=1,80) Write(12,100,ERR=99) (Yaxis(2,J),J=1,80) 100 Format(80A1) c If (Ncurve .EQ. 0 .AND. Xgrdmj .EQ. 0.0 .AND. Xgrdmr .EQ. 0.0 $ .AND. Ygrdmj .EQ. 0.0 .AND. Ygrdmr .EQ. 0.0) Then Iprtot = 1 Else Iprtot = 0 End If c Write(12,350,ERR=99) NLab,Lachst,Ntxbl,Nleg,Lechst, $ Lleg(1),Labcrd,Iprtot c If (Nleg .GT. 0) Then ! Save legend data c c See if there are any preceeding symbols or lines c Legsz = 0 Do 20 I=1,Nleg If (Symleg(I) .GT. 0 .AND. Legsz .EQ. 0) Legsz = 1 If (Linleg(I) .GT. 0 ) Legsz = 2 20 Continue c Write(12,250,ERR=99) Xleg,Yleg,Locleg,Boxleg,Sizleg, $ Legsz,Cvthik,Gblspc 250 Format(2G13.5,4I4,2G13.5) c c Write the legend labels in the file c Do 30 I=1,Nleg Call Point(K,I,Lleg) Write(12,350,ERR=99) Lleg(I),Symleg(I),Linleg(I), $ Lcolor(I) Write(12,300,ERR=99) (Lableg(J),J=K,K+Lleg(I)-1) 300 Format(A1) c 30 Continue End If c If (Ntxbl .NE. 0) Then c c Save the text block data c K = Nlab + 1 c c Save the starting location of the text block labels c Call Point(Ipoint,K,Llabel) Write(12,*) Ipoint Do 50 I=1,Ntxbl c c Write the text block parameters c Write(12,140,ERR=99) Ntxl(I),Txtblx(I),Txtbly(I), $ Txblch(I),Txblcl(I),Txbloc(I),Txbord(I),Txblsp(I) Do 40 J=1,Ntxl(I) c c Write the text block label data c Write(12,135,ERR=99) Xlabel(K),Sizlab(K),Just(K) 135 Format(G13.5,2I4) Write(12,137,ERR=99) (Label(L),L=Ipoint,Ipoint-1+ $ Llabel(K)) 137 Format(A1) Ipoint = Ipoint + Llabel(K) K = K + 1 40 Continue 50 Continue End If c If (Nlab .GT. 0) Then c c Save the labels c Do 60 I=1,Nlab Call Point(K,I,Llabel) Write(12,140,ERR=99) Llabel(I),Xlabel(I),Ylabel(I), $ Sizlab(I),Just(I),Iprot(I),Irot(I) 140 Format(I4,2G13.5,4I4,G13.5) Write(12,200,ERR=99) (Label(J),J=K,K+Llabel(I)-1) 200 Format(A1) c 60 Continue End If c c Start with the curve data c Write(12,320,ERR=99) Ncurve,Cvthik,Symbsz,Izero 320 Format(I4,2G13.5,I4) c If (Ncurve .GT. 0) Then Do 70 I=1,Ncurve c c Individual curve parameters c Write(12,350,ERR=99) Npoint(Xcurve(I)),Cvline(I), $ Cvsymb(I),Crvfit(I),Color(I),Xcvaxi(I),Ycvaxi(I), $ Xcurve(I),Ycurve(I),Cvcol(I) 350 Format(10I4) 70 Continue c c If this is the datafile for PLOTFL, write the rest of the data c If (Jflag .EQ. 1) Then c Do 80 I=1,Ncurve c c X and Y data c Call Point(Ipoint,Xcurve(I),Npoint) Write(12,400,ERR=99) (Data(J),J=Ipoint, $ Npoint(Xcurve(I)) + Ipoint-1) 400 Format(6G13.5) Call Point(Ipoint,Ycurve(I),Npoint) Write(12,400,ERR=99) (Data(J),J=Ipoint, $ Npoint(Ycurve(I)) + Ipoint-1) c If (Crvfit(I) .EQ. 7 .OR. Crvfit(I) .EQ. 8) Then Call Point(Ipoint,Cvcol(I),Npoint) Write(12,350,ERR=99) Npoint(Cvcol(I)),Izero Write(12,400,ERR=99) (Data(J),J=Ipoint, $ Npoint(Cvcol(I)) + Ipoint-1) End If 80 Continue End If End If c Close(Unit=12,ERR=99) c c Purge out earlier versions of the file c If (Jflag .NE. 1) Then Open(Unit=12,Name='PLTPRG.PLT;-1',Type='OLD',Dispose= $ 'DELETE',ERR=90) Close(Unit=12,ERR=90) 90 Continue End If c Return c c Error returns c 99 Continue c Iflag = 1 c Write(6,500) 500 Format(' WARNING - Error encountered in writing scratchfile - ', $ 'routine aborted') Close(Unit=12,ERR=101) 101 Continue Return c End Subroutine RPLDAT c 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 Include 'Cmain' Include 'Cplot' Include 'Caxis' Include 'Clabls' Include 'Cgrid' Include 'Clegnd' Include 'Ctxblk' Include 'Cdefl' Include 'Cflags' Include 'Cplsiz' c c Read presentation from file "PLTPRG.PLT" c Open(Unit=12,NAME='PLTPRG.PLT',Type='OLD',ERR=97,Readonly) c c Set flag to show plot is in file c Ipflag = 0 c Read(12,*,ERR=99,END=99) Idev c c Read number of points/column, number of characters/title c Read(12,*,END=99,ERR=99) Xlen,Ylen,Textsz,Axchst,Axthik,Spchar Read(12,*,END=99,ERR=99) Xlmin,Ylmin,Ylmin,Ylmax Read(12,*,END=99,ERR=99) Xnumbr,Ynumbr,Axtypx,Axtypy,Ticdir, $ Atxclr Read(12,*,END=99,ERR=99) Xmin,Xmax,Xinc Read(12,*,END=99,ERR=99) Ymin,Ymax,Yinc Read(12,*,END=99,ERR=99) Xgrdmj,Xgrdmr,Ygrdmj,Ygrdmr Read(12,*,END=99,ERR=99) Thikmj,Thikmr,Grdcmj,Grdcmr Read(12,*,END=99,ERR=99) Xtop,Axcolr,Lecolr,Lacolr Read(12,*,END=99,ERR=99) Delx,Dely,Space c c Read the axis titles c Read(12,100,END=99,ERR=99) (Xaxis(1,J),J=1,80) Read(12,100,END=99,ERR=99) (Xaxis(2,J),J=1,80) Read(12,100,END=99,ERR=99) (Yaxis(1,J),J=1,80) Read(12,100,END=99,ERR=99) (Yaxis(2,J),J=1,80) 100 Format(80A1) Read(12,*,END=99,ERR=99) NLab,Lachst,Ntxbl,Nleg,Lechst,Legtit, $ Labcrd,Iz c If (Nleg .GT. 0) Then ! Read legend data c Read(12,*,END=99,ERR=99) Xleg,Yleg,Locleg,Boxleg,Sizleg,Legsz, $ Dummy,Gblspc c c Read the legend labels in the file c Do 10 I=1,Nleg Call Point(K,I,Lleg) Read(12,*,END=99,ERR=99) Lleg(I),Symleg(I),Linleg(I), $ Lcolor(I) Read(12,300,END=99,ERR=99) (Lableg(J),J=K,K+Lleg(I)-1) 300 Format(A1) 10 Continue End If c c Read in the text block data: c If (Ntxbl .NE. 0) Then Read(12,*,END=99,ERR=99) Ipoint K = Nlab + 1 Do 30 I=1,Ntxbl c c Read the text block parameters c Read(12,*,END=99,ERR=99) Ntxl(I),Txtblx(I),Txtbly(I), $ Txblch(I),Txblcl(I),Txbloc(I),Txbord(I),Txblsp(I) Do 20 J=1,Ntxl(I) c c Read the text block label data c Read(12,*,END=99,ERR=99) Xlabel(K),Sizlab(K),Just(K) Read(12,175,END=99,ERR=99) Llabel(K),(Label(L),L= $ Ipoint,Ipoint-1+Llabel(K)) 175 Format(Q,132A1) Ipoint = Ipoint + Llabel(K) K = K + 1 20 Continue 30 Continue End If c If (Nlab .GT. 0) Then c c Read the labels c Do 40 I=1,Nlab Call Point(K,I,Llabel) Read(12,*,END=99,ERR=99) Llabel(I),Xlabel(I),Ylabel(I), $ Sizlab(I),Just(I),Iprot(I),Irot(I) Read(12,200,END=99,ERR=99) (Label(J),J=K,K+Llabel(I)-1) 200 Format(A1) 40 Continue End If c c Start with the curve data c Read(12,*,END=99,ERR=99) Ncurve,Cvthik,Symbsz,Iz c If (Ncurve .GT. 0) Then Do 50 I=1,Ncurve Read(12,*,END=99,ERR=99) N,Cvline(I), $ Cvsymb(I),Crvfit(I),Color(I),Xcvaxi(I),Ycvaxi(I), $ Xcurve(I),Ycurve(I),Cvcol(I) 50 Continue End If c c Finished reading the presentation data c Close(Unit=12) Return c c Error returns c 97 Continue Close(Unit=12) Return c 99 Continue Close(Unit=12) Return c End