Subroutine Legin(Jflag) c c *********************************************************************** c * * c * Subroutine LEGIN - To Enter in legends for the plot * c * * c * Output values: * c * * c * Boxleg - Flag to determine whether a border is drawn around * c * the legend * c * Lableg - Character string holding the legend labels * c * Lcolor - Array containing the color of the lines and symbols * c * defined in the legend * c * Linleg - Array containing the line types defined in legend * c * Lleg - Lengths of the text strings stored in "LABLEG" * c * Locleg - Flag indicating which corner (or center) of the * c * legend Xleg and Yleg refer to. * c * Sizleg - The size of the legend text * c * Symleg - Array containing the symbol types defined in legend * c * Xleg - X location of the legend * c * Yleg - Y location of the legend * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Clabls' Include 'Clegnd' Include 'Cplot' c Gblspc = 1.0 c c Add A Plot Legend c If (Jflag .EQ. 0) Then Nleg = 0 Write(7,450) 450 Format(/' Do you want a legend on the plot? (y/n) ',$) Call Instrg('YyNn',4,Ichose) Else Ichose = 1 End If c If (Ichose .LT. 3) Then c c See if the text coordinate system has been set up c Call Lacord(Labcrd) c c Get legend text size c 30 Write(7,500) 500 Format(/' Enter the letter size for the legend', $ ' text (0-10) ',$) Call Inchek(0,10,Sizleg) c c Get legend coordinates c 40 Write(7,550) 550 Format(/' Enter the X, Y coordinate of the legend') Call Inpt(X,N,Iflag,2) If (N .NE. 2) Then Write(7,400) 400 Format(/' Error - Try Again') Go To 40 End If Xleg = X(1) Yleg = X(2) Write(7,600) 600 Format(/' Is that X-Y pair corresponding to the legend:'// $ ' 1 Upper left'/' 2 Lower left'/' 3 Upper right'/ $ ' 4 Lower right'/' 5 Center'/' 6 Left center'/ $ ' 7 Right center'/' 8 Upper center'/' 9 Lower center'// $ ' Enter 1-9: ',$) Call Inchek(1,9,Locleg) c c See if there will be a "box" around the legend data c Write(7,650) 650 Format(/' Do you want a box around the legend? (y/n) ',$) Call Instrg('YyNn',4,Boxleg) Boxleg = (1 + Boxleg)/2 c c Get the legend title and labels c Do 50 N=1,200 If (N .EQ. 2 .AND. Ncurve .GT. 0) Then Write(7,700) 700 Format(/' LEGEND LABELS: Do you want to have the'/ $ ' corresponding curve data displayed? (y/n) ',$) Call Instrg('NnYy',4,Legtit) Legtit = (Legtit-1)/2 Else If (N .EQ. 1) Then Legtit = 0 End If Call Getleg(N,Iflag) If (Iflag .EQ. 1) Go To 60 Nleg = Nleg + 1 50 Continue 60 Continue c End If Return End Subroutine Modleg c c *********************************************************************** c * * c * Subroutine MODLEG - To modify the plot legend * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Cplot' Include 'Clabls' Include 'Clegnd' Include 'Cflags' c Character*12 Loc(9) Character*3 Box(2) Character*9 Colr(8) Byte Non(4) Data Non/'N','o','n','e'/ Data Loc/'Upper left ','Lower left ','Upper right ', $ 'Lower right ','Center ','Left center ', $ 'Right center','Upper center','Lower center'/ Data Box/'on ','off'/ Data Colr/'Black ','Red ','Dk. Green','Blue ', $ 'Orange ','Purple ','Lt. Green','Brown '/ c Write(7,100) 27,27 100 Format(1X,1A1,'[H',1A1,'[J Legend modification routine'/) 10 Continue c c Prompt user to choose which legend modification option to choose c Write(7,150) 150 Format(' MODIFY: '//' A (A)dd legend labels'/ $ ' I (I)nsert legend labels'/ $ ' C (C)hange legend labels'/' L (L)ist legend labels'/ $ ' D (D)elete legend labels'/' B Change (B)ox data'/ $ ' S (S)top'//' Enter A, C, L, D, B, or S: ',$) Call Instrg('AaIiCcLlDdBbSs',14,Ichose) Ichose = (Ichose + 1)/2 c c See if there are legend labels c If (Nleg .LT. 2) Then If (Ichose .GT. 1 .AND. Ichose .LT. 5) Go To 10 ! Skip change,list,del End If c If (Ichose .LE. 2) Call Lacord(Labcrd) c If (Ichose .EQ. 1) Then c Ipflag = 1 c c ********* Add labels to the legend *********** c If (Nleg .EQ. 0) Then c c If no legend exists (Nleg = 0) get all of the legend data c Call Legin(1) Return End If c c See if the user wants the corresponding curve data displayed c If (Ncurve .GE. Nleg) Then Write(7,175) 175 Format(/' LEGEND LABELS: Do you want to have the'/ $ ' corresponding curve data displayed? (y/n) ',$) Call Instrg('NnYy',4,Legtit) Legtit = (Legtit-1)/2 Else Legtit = 0 End If c 20 Continue c N = Nleg + 1 Call Getleg(N,Iflag) c If (Iflag .EQ. 0) Then Nleg = Nleg + 1 Go To 20 End If Else If (Ichose .EQ. 2) Then c c Insert legend labels c Write(7,185) 185 Format(' Enter the label number to insert after ',$) Call Inchek(0,Nleg-1,Icol) Icol = Icol + 2 c c Adjust pointers for the insertion c Do 15 I=Nleg+1,Icol+1,-1 Lleg(I) = Lleg(I-1) Symleg(I) = Symleg(I-1) Linleg(I) = Linleg(I-1) Lcolor(I) = Lcolor(I-1) 15 Continue Lleg(Icol) = 0 Legtit = 0 Nleg = Nleg + 1 Call Getleg(Icol,Iflag) If (Iflag .EQ. 1) Then Nleg = Nleg - 1 Do 17 I=Icol,Nleg Lleg(I) = Lleg(I+1) Symleg(I) = Symleg(I+1) Linleg(I) = Linleg(I+1) Lcolor(I) = Lcolor(I+1) 17 Continue End If c Else If (Ichose .EQ. 3) Then c c ******** Change the Legend labels ******** c Write(7,200) 200 Format(/' Change legend labels...Enter the label number to', $ ' change ',$) Call Inchek(1,Nleg-1,Icol) Icol = Icol + 1 Call Name(Titl,Icol,Lableg,Lleg) c c Write out the legend label parameters c 25 Continue c Write(7,225) (Titl(I),I=1,Lleg(Icol)),Symleg(Icol), $ Linleg(Icol), Colr(Lcolor(Icol)) 225 Format(/' Current Legend Label Data:'//' T (T)ext: ', $ A1/' Y s(Y)mbol (no symbol = 0) = ',I2/ $ ' L (L)ine Pattern (no line = 0) = ',I2/ $ ' C (C)olor of the line and symbol = ',A9/ $ ' A (A)ll'/ $ ' S (S)top'// $ ' Enter T, Y, L, C, A, or S: ',$) Call Instrg('TtYyLlCcAaSs',12,Ich) Ich = (Ich + 1)/2 If (Ich .LE. 5) Ipflag = 1 If (Ich .EQ. 1) Then c c Change legend text c Write(7,250) Icol-1 250 Format(' Edit the text for legend label number ',I2) Call Name(Titl,Icol,Lableg,Lleg) J = Lleg(Icol) Call Linedt(Titl,J,80,1) If (J .EQ. 0) Then Write(7,300) 300 Format(' ERROR - Label cannot have zero length - ', $ 'change aborted') Go To 25 End If Call Point(K,Nleg+1,Lleg) Call Point(K1,Icol,Lleg) Call Rep(Lableg,K,K1,Lleg(Icol),Titl,J) Lleg(Icol) = J Else If (Ich .EQ. 2) Then c c Change preceeding symbol c Write(7,325) 325 Format(' Enter the symbol to proceed the text (0-11) ',$) Call Inchek(0,11,Symleg(Icol)) Else If (Ich .EQ. 3) Then c c Change preceeding line pattern c Write(7,350) 350 Format(' Enter the line pattern to proceed the text', $ ' (0-10) ',$) Call Inchek(0,10,Linleg(Icol)) Else If (Ich .EQ. 4) Then c c Change line and symbol color c Write(7,360) (L,Colr(L),L=1,8) 360 Format(' Enter the new color:'//8(I2,2X,A9/)/ $ ' Enter 1-8: ',$) Call Inchek(1,8,Lcolor(Icol)) Else If (Ich .EQ. 5) Then c c Change all of the above c Call Getleg(Icol,Iflag) Else Go To 10 End If Go To 25 Else If (Ichose .EQ. 4) Then c c ********* List the legend text data ********** c Do 30 I=2,Nleg Call Name(Titl,I,Lableg,Lleg) Write(7,375) I-1,(Titl(J),J=1,Lleg(I)),Symleg(I), $ Linleg(I),Colr(Lcolor(I)) 375 Format(1X,30('*'),2X,'Label ',I2,2X,30('*')/' Text: ', $ A1/' Symbol (none = 0) = ',I2,4X, $ ' Line Pattern (none = 0) = ',I2,4X,'Color: ',A9) If (((I-1)/7)*7 .EQ. I-1 .OR. I .EQ. Nleg) Call Spause 30 Continue c Else If (Ichose .EQ. 5) Then c c *********** Delete the label data *********** c Write(7,450) 450 Format(' Legend deletion routine...enter the label number(s) ', $ 'to delete ') Call Inpt(X,N,Iflag,0) If (N .EQ. 0) Go To 50 If (N .GT. 1) Call Sort(X,Y,N) ! Sort causes error for only 1 point Do 40 I=1,N If (X(I) .LT. 1.0 .OR. X(I) .GT. Nleg-1) Then Write(7,475) 475 Format(' Error - input value out of range - no ', $ 'deletions made') Go To 50 End If 40 Continue Ipflag = 1 c c Delete data here c Do 45 I=1,N Icol = X(N+1-I) + 1 Call Point(K,Nleg+1,Lleg) Call Point(K1,Icol,Lleg) Call Rep(Lableg,K,K1,Lleg(Icol),' ',0) Nleg = Nleg - 1 If (Icol .LE. Nleg) Then Do 42 J=Icol,Nleg Lleg(J) = Lleg(J+1) Symleg(J) = Symleg(J+1) Linleg(J) = Linleg(J+1) Lcolor(J) = Lcolor(J+1) 42 Continue End If 45 Continue 50 Continue Else If (Ichose .EQ. 6) Then c c ********** Change the legend box characteristics ************ c 60 Continue c c Write out the current Legend box parameters c If (Lleg(1) .EQ. 0) Then K = 4 Write(7,500) (Non(J),J=1,4),Xleg,Yleg,Loc(Locleg), $ Sizleg,Gblspc,Box(Boxleg) Else K = Lleg(1) Write(7,500) (Lableg(J),J=1,K),Xleg,Yleg,Loc(Locleg), $ Sizleg,Gblspc,Box(Boxleg) End If 500 Format(' Changing Legend Box Data:'// $ ' H (H)eader title: ',A1/ $ ' X (X) location = ',G12.5/ $ ' Y (Y) location = ',G12.5/ $ ' C (C)oordinate reference: ',A12/ $ ' T (T)ext size index = ',I2/ $ ' V (V)ertical spacing factor = ',G12.5/ $ ' B (B)ox border: ',A3/ $ ' S (S)top'// $ ' Enter H, X, Y, C, T, V, B, or S: ',$) Call Instrg('XxYyCcTtVvBbHhSs',16,Ich) Ich = (Ich + 1)/2 c If (Ich .LE. 6) Then Ipflag = 1 Call Lacord(Labcrd) End If c If (Ich .EQ. 1) Then c c Get the changed X and Y values c 70 Continue Write(7,525) 'X' 525 Format(' Enter the Legend ',1A1,' location: ',$) Call Indata(1,'R',Xleg) Else If (Ich .EQ. 2) Then 80 Continue Write(7,525) 'Y' Call Indata(1,'R',Yleg) Else If (Ich .EQ. 3) Then c c Get the new coordinate reference location c Write(7,600) (K,Loc(K),K=1,9) 600 Format(/' Is that X-Y pair corresponding to the legend:'// $ 9(I2,2X,A12/)/' Enter 1-9: ',$) Call Inchek(1,9,Locleg) Else If (Ich .EQ. 4) Then c c Get the text character size c Write(7,650) 650 Format(/' Enter the letter size for the legend text', $ ' (0-10) ',$) Call Inchek(0,10,Sizleg) Else If (Ich .EQ. 5) Then Write(7,660) 660 Format(/' Enter the vertical spacing factor value ',$) Call Indata(1,'R',Gblspc) Gblspc = Amin1(2.0,Amax1(0.3,Gblspc)) Else If (Ich .EQ. 6) Then c c Set up the box borders c Boxleg = 3 - Boxleg c Else If (Ich .EQ. 7) Then c c Change the legend title c Write(7,700) 700 Format(' Edit the header text:') Call Name(Titl,1,Lableg,Lleg) J = Lleg(1) Call Linedt(Titl,J,80,1) If (J .EQ. 0) Write(7,750) 750 Format(' Legend header is removed') Call Point(K,Nleg+1,Lleg) Call Point(K1,1,Lleg) Call Rep(Lableg,K,K1,Lleg(1),Titl,J) Lleg(1) = J If (Nleg .EQ. 1 .AND. Lleg(1) .EQ. 0) Nleg = 0 c Else c c Finished changing the legend box attributes c Go To 10 End If Go To 60 Else c c Finished changing the legend data c Return End If Go To 10 c End