Subroutine Viegph c c *********************************************************************** c * * c * Subroutine VIEGPH - To make up a Viewgraph. This routine * c * enables the user to create a viewgraph with a minimum of * c * effort. It uses the plot presentation to hold the data, * c * and sets all non-viewgraph parameters (such as axes lenghts) * c * to default values. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Clabls' Include 'Ctxblk' Include 'Clegnd' Include 'Cplot' Include 'Cgrid' Include 'Caxis' Include 'Cdefl' Include 'Cflags' c Character*9 Colors(8) Character*14 Font(9) Data Colors/'Black ','Red ','Dk. Green','Blue ', $ 'Orange ','Purple ','Lt. Green','Brown '/ Data Font/'Hardware ','Simplex Roman ','Duplex Roman ', $ 'Complex Roman ','Triplex Roman ','Complex Italic', $ 'Triplex Italic','Complex Script','Gothic English'/ c Write(6,100) 27,27,27 100 Format(1X,1A1,'[H',1A1,'[J',1X,1A1,'#6 VIEWGRAPHS'/) c c See if there a previous plot and ask if it is ok to c destroy this previous data c 10 Continue Write(6,150) 150 Format(/' Select Viewgraph option:'// $ ' M (M)ake a viewgraph'/ $ ' C (C)hange a viewgraph'/ $ ' R (R)ead and convert a text file to a viewgraph'/ $ ' S (S)top'//' Enter M, C, R, or S: ',$) Call Instrg('MmCcRrSs',8,Ichose) Ichose = (Ichose+1)/2 c If (Ichose .EQ. 1 .OR. Ichose .EQ. 3) Then c c Make a new viewgraph c If (Xmin(1) .LT. Xmax(1) .AND. Xlen .GT. 0.0) Then Write(6,200) 200 Format(' Plot presentation exists - OK to destroy?', $ ' (y/n) '$) Call Instrg('YyNn',4,Iflag) If (Iflag .GT. 2) Return End If c c Set the default values c Call Deflt c c Initialize various plot parameter values c Ntxbl = 1 Nlab = 0 Nleg = 0 Textsz = 0 Lachst = 1 Lacolr = 1 Ncurve = 0 Labcrd = 1 Xlen = 8.0 Ylen = 7.0 Xgrdmj = 0.0 Xgrdmr = 0.0 Ygrdmj = 0.0 Ygrdmr = 0.0 Txbord(1) = 2 Txtblx(1) = 0.5 Txtbly(1) = 0.5 Txbloc(1) = 5 Txblcl(1) = 1 Txblch(1) = 1 Txblsp(1) = 1.0 Xmin(1) = 0.0 Xmax(1) = 1.0 Xinc(1) = 1.0 Ymin(1) = 0.0 Ymax(1) = 1.0 Yinc(1) = 1.0 Axthik = 0.0 Ipflag = 1 c If (Ichose .EQ. 1) Then Call Addviw Else Txblsp(1) = 0.5 Call Viewfl End If c Else If (Ichose .EQ. 2) Then c c Change the viewgraph: c 20 Continue Write(6,250) 250 Format(/' Select to change:'//' I (I)nsert labels'/ $ ' A (A)dd labels'/' C (C)hange labels'/ $ ' L (L)ist labels'/' D (D)elete labels'/ $ ' V (V)iewgraph parameters'/' S (S)top'// $ ' Enter I, A, C, L, D, V, or S: ',$) Call Instrg('IiAaCcLlDdVvSs',14,Ich) Ich = (Ich + 1) / 2 If (Ich .NE. 7) Ipflag = 1 c If (Ich .LE. 5) Then c c Change the text in the viewgraph c Call Change(1,Ich,1) c Else If (Ich .EQ. 6) Then c c Change the viewgraph parameters c 30 Continue Write(6,300) Colors(Txblcl(1)),Font(Txblch(1)+1), $ Txblsp(1) 300 Format(/' Current Viewgraph Parameters'// $ ' C (C)olor is ',A9/ $ ' F (F)ont is ',A14/ $ ' G (G)lobal spacing factor = ',G11.4/ $ ' S (S)top'//' Enter C, F, G, or S: ',$) Call Instrg('CcFfGgSs',8,Iflag) Iflag = (Iflag + 1) / 2 c If (Iflag .EQ. 1) Then c c Change the color c Write(6,350) (K,Colors(K),K=1,8) 350 Format(' Select the new Viewgraph color:'// $ 8(I2,') ',A9/)/' Enter 1-8: ',$) Call Inchek(1,8,Txblcl(1)) c Else If (Iflag .EQ. 2) Then c c Change the text font c Write(6,400) (K-1,Font(K),K=1,9) 400 Format(' Select the new Viewgraph text font:'// $ 9(I2,') ',A14/)/' Enter 0-8: ',$) Call Inchek(0,8,Txblch(1)) c Else If (Iflag .EQ. 3) Then c c Change the global vertical spacing value c Write(6,450) 450 Format(' Enter the new global text spacing factor ', $ 'value ',$) Call Indata(1,'R',Txblsp(1)) Else Go To 20 End If Go To 30 Else Go To 40 End If Go To 20 Else Return End If 40 Continue Call Yaxln(Ylen,1) Call Xaxln(Xlen,1) End Subroutine Addviw c c *********************************************************************** c * Subroutine Addviw - To enter the viewgraph text * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Clabls' Include 'Ctxblk' Include 'Cflags' c Ipflag = 1 Ntxl(1) = 0 Nlines = 0 c c Get the labels for the viewgraph c 10 Continue c Write(6,100) Ntxl(1) + 1 100 Format(' Enter the text for viewgraph line number ',I2/ $ ' (press return to stop)') Call Linedt(Titl,Len,80,0) If (Len .EQ. 0) Return c Ntxl(1) = Ntxl(1) + 1 Nlines = Nlines + 1 Call Point(K,Nlines,Llabel) J = 0 Call Rep(Label,K,K,J,Titl,Len) Llabel(Nlines) = Len c c Get the label size c Write(6,200) 200 Format(' Enter the text size for the line (1-10) ',$) Call Inchek(1,10,Sizlab(Nlines)) c c Get the text justification c Write(6,300) 300 Format(' Enter L, C, or R, for (L)eft, (C)enter, or', $ ' (R)ight justification of the line ',$) Call Instrg('LlCcRr',6,Ichose) Just(Nlines) = (Ichose + 1) / 2 Irot(Nlines) = 0 ! No rotation of text c If (Ntxl(1) .GT. 1) Then Xlabel(Nlines) = Amax1(Sizlab(Nlines)*1.0, $ (Sizlab(Nlines)+Sizlab(Nlines-1))/2.0)/ $ Sizlab(Nlines) Else Xlabel(Nlines) = 0.0 End If c Go To 10 End Subroutine Viewfl c c *********************************************************************** c * * c * Subroutine Viewfl - To read a text file. This routine * c * enables the user to create a viewgraph with a minimum of * c * effort. It uses the plot presentation to hold the data, * c * and sets all non-viewgraph parameters (such as axes lenghts) * c * to default values. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Character*60 File_Name c Include 'Cmain' Include 'Clabls' Include 'Ctxblk' Include 'Clegnd' Include 'Cplot' Include 'Cgrid' Include 'Caxis' Include 'Cdefl' c Ntxl(1) = 0 Nlines = 0 Ltot = 0 c c Get the file name with the text for the viewgraph c 5 Continue Write(6,100) 100 Format(/' Text file to viewgraph conversion'// $ ' Enter the file name containing the viewgraph text') Read(5,150,END=5,ERR=5) File_Name 150 Format(A) Call Chknam(File_Name,Iflag) If (Iflag .EQ. 1) Return c Write(6,200) 200 Format(' Enter the text size for the viewgraph (1-10) ',$) Call Inchek(1,10,Isize) c Open(Unit=12,Name=File_Name,Type='OLD',Carriagecontrol='LIST', $ ERR=98,Readonly) c 10 Continue c Read(12,300,END=30,ERR=30) Len,(Titl(I),I=1,Len) 300 Format(Q,132A1) c Ltot = Ltot + Len If (Ltot .GT. Lachmx) Go To 95 Ntxl(1) = Ntxl(1) + 1 Nlines = Nlines + 1 Call Point(K,Nlines,Llabel) J = 0 Call Rep(Label,K,K,J,Titl,Len) Llabel(Nlines) = Len c c Set the text justification c Just(Nlines) = 1 ! Left justified Irot(Nlines) = 0 ! No rotation of text Sizlab(Nlines) = Isize c If (Ntxl(1) .GT. 1) Then Xlabel(Nlines) = Amax1(Sizlab(Nlines)*1.0, $ (Sizlab(Nlines)+Sizlab(Nlines-1))/2.0)/ $ Sizlab(Nlines) Else Xlabel(Nlines) = 0.0 End If c If (Nlines .LT. 50) Go To 10 Write(6,400) 400 Format(' More than 50 lines of text were read in -'/ $ ' Only the first 50 lines will be saved') 30 Continue c Close(Unit=12) Return 95 Continue Write(6,475) Nlines,7 475 Format(' ERROR - Too many characters - only',I3,' lines will', $ ' be saved',1A1) Close(Unit=12) Return 98 Continue Write(6,500) 500 Format(' Error occurred when opening the file - routine aborted') Close(Unit=12) Return End