Subroutine Legin(Jflag) *********************************************************************** * * * Subroutine LEGIN - To Enter in legends for the plot * * * * Output values: * * * * Boxleg - Flag to determine whether a border is drawn around * * the legend * * Lableg - Character string holding the legend labels * * Lcolor - Array containing the color of the lines and symbols * * defined in the legend * * Linleg - Array containing the line types defined in legend * * Lleg - Lengths of the text strings stored in "LABLEG" * * Locleg - Flag indicating which corner (or center) of the * * legend Xleg and Yleg refer to. * * Sizleg - The size of the legend text * * Symleg - Array containing the symbol types defined in legend * * Xleg - X location of the legend * * Yleg - Y location of the legend * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * *********************************************************************** Include 'Cmain' Include 'Cplot' Include 'Clegnd' Include 'Clabls' Gblspc = 1.0 Add A Plot Legend If (Jflag .EQ. 0) Then Nleg = 0 Write(6,450) 50 Format(/' Do you want a legend on the plot? (y/n) ',$) Call Instrg('YyNn',4,Ichose) Else Ichose = 1 End If If (Ichose .LT. 3) Then See if the text coordinate system has been set up Call Lacord(Labcrd) Get legend text size 0 Write(6,500) 00 Format(/' Enter the letter size for the legend', $ ' text (1-10) ',$) Call Inchek(1,10,Sizleg) Get legend coordinates 0 Write(6,550) 50 Format(/' Enter the X, Y coordinate of the legend') Call Inpt(X,N,Iflag,2) If (N .NE. 2) Then Write(6,400) 00 Format(/' Error - Try Again') Go To 40 End If Xleg = X(1) Yleg = X(2) Write(6,600) 00 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) See if there will be a "box" around the legend data Write(6,650) 50 Format(/' Do you want a box around the legend? (y/n) ',$) Call Instrg('YyNn',4,Boxleg) Boxleg = (1 + Boxleg)/2 Get the legend title and labels Do 50 N=1,200 If (N .EQ. 2 .AND. Ncurve .GT. 0) Then Write(6,700) 00 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 End If Return End Subroutine Modleg *********************************************************************** * * * Subroutine MODLEG - To modify the plot legend * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * *********************************************************************** Include 'Cmain' Include 'Cplot' Include 'Clegnd' Include 'Clabls' Include 'Cflags' 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 '/ Write(6,100) 27,27 00 Format(1X,1A1,'[H',1A1,'[J Legend modification routine'/) 10 Continue Prompt user to choose which legend modification option to choose Write(6,150) 50 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 See if there are legend labels If (Nleg .LT. 2) Then If (Ichose .GT. 1 .AND. Ichose .LT. 5) Go To 10 ! Skip change,list,del End If If (Ichose .LE. 2) Call Lacord(Labcrd) If (Ichose .EQ. 1) Then Ipflag = 1 ********* Add labels to the legend *********** If (Nleg .EQ. 0) Then If no legend exists (Nleg = 0) get all of the legend data Call Legin(1) Return End If See if the user wants the corresponding curve data displayed If (Ncurve .GE. Nleg) Then Write(6,175) 75 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 0 Continue N = Nleg + 1 Call Getleg(N,Iflag) If (Iflag .EQ. 0) Then Nleg = Nleg + 1 Go To 20 End If Else If (Ichose .EQ. 2) Then Insert legend labels Write(6,185) 85 Format(' Enter the label number to insert after ',$) Call Inchek(0,Nleg-1,Icol) Icol = Icol + 2 Adjust pointers for the insertion 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 Else If (Ichose .EQ. 3) Then ******** Change the Legend labels ******** Write(6,200) 00 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) Write out the legend label parameters 25 Continue Write(6,225) (Titl(I),I=1,Lleg(Icol)),Symleg(Icol), $ Linleg(Icol), Colr(Lcolor(Icol)) 25 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 Change legend text Write(6,250) Icol-1 50 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(6,300) 00 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 Change preceeding symbol Write(6,325) 25 Format(' Enter the symbol to proceed the text (0-11) ',$) Call Inchek(0,11,Symleg(Icol)) Else If (Ich .EQ. 3) Then Change preceeding line pattern Write(6,350) 50 Format(' Enter the line pattern to proceed the text', $ ' (0-10) ',$) Call Inchek(0,10,Linleg(Icol)) Else If (Ich .EQ. 4) Then Change line and symbol color Write(6,360) (L,Colr(L),L=1,8) 60 Format(' Enter the new color:'//8(I2,2X,A9/)/ $ ' Enter 1-8: ',$) Call Inchek(1,8,Lcolor(Icol)) Else If (Ich .EQ. 5) Then Change all of the above Call Getleg(Icol,Iflag) Else Go To 10 End If Go To 25 Else If (Ichose .EQ. 4) Then ********* List the legend text data ********** Do 30 I=2,Nleg Call Name(Titl,I,Lableg,Lleg) Write(6,375) I-1,(Titl(J),J=1,Lleg(I)),Symleg(I), $ Linleg(I),Colr(Lcolor(I)) 75 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 0 Continue Else If (Ichose .EQ. 5) Then *********** Delete the label data *********** Write(6,450) 50 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(6,475) 75 Format(' Error - input value out of range - no ', $ 'deletions made') Go To 50 End If 0 Continue Ipflag = 1 Delete data here 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) 2 Continue End If 5 Continue 0 Continue Else If (Ichose .EQ. 6) Then ********** Change the legend box characteristics ************ 0 Continue Write out the current Legend box parameters If (Lleg(1) .EQ. 0) Then K = 4 Write(6,500) (Non(J),J=1,4),Xleg,Yleg,Loc(Locleg), $ Sizleg,Gblspc,Box(Boxleg) Else K = Lleg(1) Write(6,500) (Lableg(J),J=1,K),Xleg,Yleg,Loc(Locleg), $ Sizleg,Gblspc,Box(Boxleg) End If 00 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 If (Ich .LE. 7) Then Ipflag = 1 Call Lacord(Labcrd) End If If (Ich .EQ. 1) Then Get the changed X and Y values 0 Continue Write(6,525) 'X' 25 Format(' Enter the Legend ',1A1,' location: ',$) Call Indata(1,'R',Xleg) Else If (Ich .EQ. 2) Then 0 Continue Write(6,525) 'Y' Call Indata(1,'R',Yleg) Else If (Ich .EQ. 3) Then Get the new coordinate reference location Write(6,600) (K,Loc(K),K=1,9) 00 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 Get the text character size Write(6,650) 50 Format(/' Enter the letter size for the legend text', $ ' (0-10) ',$) Call Inchek(0,10,Sizleg) Else If (Ich .EQ. 5) Then Write(6,660) 60 Format(/' Enter the vertical spacing factor value', $ ' (0.3 to 2.0) ',$) Call Indata(1,'R',Gblspc) Gblspc = Amin1(2.0,Amax1(0.3,Gblspc)) Else If (Ich .EQ. 6) Then Set up the box borders Boxleg = 3 - Boxleg Else If (Ich .EQ. 7) Then Change the legend title Write(6,700) 00 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(6,750) 50 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 Else Finished changing the legend box attributes Go To 10 End If Go To 60 Else Finished changing the legend data Return End If Go To 10 End