Subroutine INPLOT(Data) c c *********************************************************************** c * * c * Subroutine INPLOT - To read the current plot presentation * c * from a file. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Ctxblk' Include 'Caxis' Include 'Clabls' Include 'Cplot' Include 'Cgrid' Include 'Clegnd' Include 'Cdefl' Include 'Cflags' c Virtual Data(1) c Character*60 File_Name c c Get the file name to recall the data c Write(6,100) 27,27,27 100 Format(1X,1A1,'[H',1A1,'[J'/1X,1A1,'#6 RECALL PRESENTATION', $ ' ROUTINE'//' Enter the file name to read the data from '$) Read(5,125,END=97,ERR=97) File_name 125 Format(A) c c Check the file name syntax c Call Chknam(File_Name,Iflag) c c If there is an error with the file name/etc, return c If (Iflag .EQ. 1) Return c Open(Unit=12,NAME=File_Name,TYPE='OLD',ERR=98,Readonly) c c Set flag to indicate that the plot data is changed c Ipflag = 1 c c Read number of points/column, number of characters/title c Read(12,*,END=99,ERR=99) Xlen,Ylen,Textsz,Axchst,Axthik,Spchar, $ Type,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) Ivers,Axcolr,Lecolr,Lacolr Xtop = 0 If (Ivers .GE. 7) Read(12,*,END=99,ERR=99) Xtop,Iblank,Iblank, $ Iblank,Iblank c c Read the axis titles c Read(12,150,END=99,ERR=99) (Xaxis(1,J),J=1,80) Read(12,150,END=99,ERR=99) (Xaxis(2,J),J=1,80) Read(12,150,END=99,ERR=99) (Yaxis(1,J),J=1,80) Read(12,150,END=99,ERR=99) (Yaxis(2,J),J=1,80) 150 Format(80A1) Read(12,*,END=99,ERR=99) NLab,Lachst,Nleg,Lechst,Ntxbl,Labcrd If (Nlab .GT. 0) Then c c Read the labels c Do 40 I=1,Nlab Call Point(K,I,Llabel) Read(12,175,END=99,ERR=99) Llabel(I),(Label(J),J=K, $ K+Llabel(I)-1) 175 Format(Q,80A1) If (Ivers .LT. 3) Then Read(12,*,END=99,ERR=99) Xlabel(I),Ylabel(I),Sizlab(I), $ Just(I) Iprot(I) = 0 Irot(I) = 0 Else If (Ivers .LE. 5) Then Read(12,*,END=99,ERR=99) Xlabel(I),Ylabel(I), $ Sizlab(I),Just(I),Iprot(I) Irot(I) = 0 Else Read(12,*,END=99,ERR=99) Xlabel(I),Ylabel(I), $ Sizlab(I),Just(I),Iprot(I),Irot(I) End If End If 40 Continue End If c c Read in the text block data c If (Ivers .GT. 3 .AND. Ntxbl .GT. 0) Then K1 = Nlab + 1 Call Point(K,K1,Llabel) Do 45 I=1,Ntxbl If (Ivers .GT. 4) Then Read(12,*,END=99,ERR=99) Ntxl(I),Txblch(I),Txblcl(I), $ Txbloc(I),Txbord(I),Txtblx(I),Txtbly(I),Txblsp(I) Else Read(12,*,END=99,ERR=99) Ntxl(I),Txblch(I),Txblcl(I), $ Txbloc(I),Txbord(I),Txtblx(I),Txtbly(I) Txblsp(I) = 1.0 End If Do 47 J=1,Ntxl(I) Read(12,175,END=99,ERR=99) LLabel(K1),(Label(L),L=K, $ K+Llabel(K1)-1) Read(12,*,END=99,ERR=99) Xlabel(K1),Sizlab(K1),Just(K1) K = K + Llabel(K1) K1 = K1 + 1 47 Continue 45 Continue Else Ntxbl = 0 End If c If (Nleg .GT. 0) Then ! Read legend data c Read(12,*,END=99,ERR=99) Xleg,Yleg,Locleg,Boxleg,Sizleg, $ Legsz,Gblspc If (Ivers .LT. 8) Gblspc = 1.0 c c Read the legend labels in the file c Do 50 I=1,Nleg Call Point(K,I,Lleg) Read(12,175,END=99,ERR=99) Lleg(I),(Lableg(J),J=K, $ K+Lleg(I)-1) Read(12,*,END=99,ERR=99) Symleg(I),Linleg(I),Lcolor(I) 50 Continue End If c c Start with the curve data c Read(12,*,END=99,ERR=99) Ncurve,Cvthik,Symbsz c If (Ncurve .GT. 0) Then Iflag = 0 Nucols = Ncols Call Point(Iend,Ncols+1,Npoint) I = 1 Do 80 K=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) c c Check & read the curve X column data c If (Type .GT. 0.0) Then Call Find(Data,Iflag,Nucols,Xcurve(I),N,Ivers,'X') If (Iflag .EQ. 5) Go To 99 c c Check & read the curve Y column data c Call Find(Data,Iflag,Nucols,Ycurve(I),N,Ivers,'Y') If (Iflag .EQ. 5) Go To 99 c c See if the curve has correseponding data c End If If (Crvfit(I) .EQ. 7 .OR. Crvfit(I) .EQ. 8) Then Read(12,*,END=99,ERR=99) Cvcol(I),N If (Type .GT. 0.0) Then Call Find(Data,Iflag,Nucols,Cvcol(I),N,Ivers,'Z') If (Iflag .EQ. 5) Go To 99 End If End If If (Xcurve(I) .LE. Nucols .AND. Ycurve(I) .LE. Nucols) Then I = I + 1 If (Cvcol(I) .GT. Nucols) I = I - 1 End If c 80 Continue c Ncurve = I - 1 If ((Iflag .EQ. 2 .OR. Iflag .EQ. 1) .AND. Type .GT. 0.0) Then Ncols = Nucols Idflag = 1 End If End If c c Finished reading the presentation data c Close(Unit=12) Return c c Error returns c 97 Continue Write(6,471) 471 Format(' ERROR - Bad filename - routine aborted') Return c 98 Continue Write(6,475) 475 Format(' WARNING - Error encountered in opening file - ', $ 'routine aborted') Return c 99 Continue Write(6,500) 500 Format(' WARNING - Error encountered in reading data - ', $ 'routine aborted') Close(Unit=12) Return c End Subroutine Find(Data,Iflag,Nucols,Icol,N,Ivers,Str) c c *********************************************************************** c * * c * Subroutine FIND - To read in the X, Y data from the plot * c * presentation file. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' c Virtual Data(1) Byte Nom(12),Str Data Nom /'C','U','R','V','E',4*' ','(',' ',')'/ c c Read in the presentation curve column title c Call Point(Ist,Nucols+1,Ttllen) If (Ivers .GE. 2 .AND. Nucols .LE. Ncolmx-1) Then Read(12,100,END=99,ERR=99) Ttllen(Nucols+1),(Title(J), $ J=Ist,Ist+Ttllen(Nucols+1)-1) 100 Format(Q,80A1) Else If (Nucols .LE. Ncolmx-2 .AND. Ivers .LT. 2) Then Ttllen(Nucols+1) = 12 I = 1 + ((Nucols - Ncols)/2) Nom(11) = Str Nom(7) = 48 + I/10 If (Nom(7) .EQ. '0') Nom(7) = ' ' Nom(8) = 48 + I - (I/10) * 10 Do 5 J=1,12 Title(Ist-1+J) = Nom(J) 5 Continue Else If (Ivers .GE. 2) Then Read(12,100,END=99,ERR=99) Nchars,(Titl(I),I=1,Nchars) End If c c Read in the data itself c Read(12,*,END=99,ERR=99) (X(J),J=1,N) c c See if we have a match with the current data c If (Icol .LE. Ncols .AND. N .EQ. Npoint(Icol)) Then Call Getvec(Data,Npoint,Icol,Y,Nn) Do 10 I=1,N If (X(I) .NE. Y(I)) Go To 20 10 Continue Return End If c 20 Continue c c No luck..so look for columns with the same title c Do 60 I=1,Nucols If (Ttllen(I) .GE. Ttllen(Nucols+1)) Then Call Point(Is,I,Ttllen) Call Point(Is1,Nucols+1,Ttllen) Do 30 J=1,Ttllen(Ncol+1) If (Title(Is+J-1) .NE. Title(Is1-1+J)) Go To 60 30 Continue Do 40 J=Ttllen(Nucols+1)+1,Ttllen(I) If (Title(Is+J-1) .NE. ' ') Go To 60 40 Continue If (Npoint(I) .EQ. N ) Then Call Getvec(Data,Npoint,I,Y,Nn) Do 50 J=1,N If (X(J) .NE. Y(J)) Go To 60 50 Continue Icol = I Return End If End If 60 Continue c c Now brute force it - see if we have any match! c Do 80 I=1,Nucols If (Npoint(I) .EQ. N) Then Call Getvec(Data,Npoint,I,Y,Nn) Do 70 J=1,N If (X(J) .NE. Y(J)) Go To 80 70 Continue Icol = I Return End If 80 Continue c c No match found - See if the user wants to add this c data to the presentation c If (Iflag .EQ. 0 .AND. Nucols .LE. Ncolmx-1) Then Write(6,300) 27,27 300 Format(/1X,A1,'[1;7mCAUTION',1A1,'[0m... The data', $ ' points for some of the curves'/' did not match the', $ ' current data loaded in the program.'/ $ ' Do you wish to add this data to the program? ',$) Call Instrg('YyNn',4,Iflag) End If c If ((Iflag .EQ. 1 .OR. Iflag .EQ. 2) .AND. Nucols .LE. $ Ncolmx-1) Then Nucols = Nucols + 1 Npoint(Nucols) = N Icol = Nucols Call Point(Iend,Nucols,Npoint) Do 90 I=1,N Data(Iend+I-1) = X(I) 90 Continue End If Return c 99 Continue Iflag = 5 Return End