Subroutine AXIN c c *********************************************************************** c * * c * Subroutine AXIN - To input the plot presentation axis data * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Caxis' Include 'Cgrid' c c Tell the user what he is doing c Write(6,100) 100 Format(/' Plot axes setup.... '/) c c Get the X axis data c Call Ax(Xmin(1),Xmax(1),Xinc(1),Xaxis(1,1),'X',1) c c See if the user wants a secondary X axis c Write(6,200) 'X' 200 Format(/' Do you want a secondary ',1A1,' axis? (y/n) ',$) Call Instrg('NnYy',4,Xnumbr) Xnumbr = (1+Xnumbr)/2 c c If yes, get the secondary X axis data from the user c If (Xnumbr .EQ. 2) Then Call Ax(Xmin(2),Xmax(2),Xinc(2),Xaxis(2,1),'Secondary X',11) End If c c Get the Y axis data c Call Ax(Ymin(1),Ymax(1),Yinc(1),Yaxis(1,1),'Y',1) c c See if the user wants a secondary y axis c Write(6,200) 'Y' Call Instrg('NnYy',4,Ynumbr) Ynumbr = (1+Ynumbr)/2 c c If yes,get the secondary Y axis data from the user c If (Ynumbr .EQ. 2) Then Call Ax(Ymin(2),Ymax(2),Yinc(2),Yaxis(2,1),'Secondary Y',11) End If c c Get the Axes lengths c 10 Continue Write(6,300) 300 Format(/' Enter the X and Y axes lengths (in inches) ',$) Call Indata(2,'RR',Xlen,Ylen) c c See if the axis lengths are reasonable (>.01 inches) c If (Xlen .LT. 01 .OR. Ylen .LT. 0.1) Then Write(6,400) 400 Format(/' Axis Lengths are too small or negative - Try Again') Go To 10 End If c c See If the user wants a grid c Write(6,500) 500 Format(/' Do you want a grid on the plot? (y/n) ',$) Call Instrg('NnYy',4,Iflag) If (Iflag .LT. 3) Then c c No grid wanted - so set Xgrid and Ygrid to zero c Xgrdmj = 0.0 Xgrdmr = 0.0 Ygrdmj = 0.0 Ygrdmr = 0.0 c Else 20 Continue c c User inputs the grid increments c Write(6,600) 600 Format(/' Enter the X major and minor grid', $ ' increments ',$) Call Indata(2,'RR',Xgrdmj,Xgrdmr) c c See if the grid increments are positive - otherwise, give c an error c If (Xgrdmj .LT. 0.0 .OR. Xgrdmr .LT. 0.0) Then Write(6,700) 700 Format(' Error - negative grid increment - Try Again') c Go To 20 End If 30 Continue Write(6,605) 605 Format(/' Enter the Y major and minor grid', $ ' increments ',$) Call Indata(2,'RR',Ygrdmj,Ygrdmr) If (Ygrdmj .LT. 0.0 .OR. Ygrdmr .LT. 0.0) Then Write(6,700) Go To 30 End If End If c c Get the axes text size c Write(6,750) 750 Format(/' Enter the axes text size (0-10) ',$) Call Inchek(0,10,Textsz) Return End Subroutine AX(Amin,Amax,Ainc,Label,Strin,Nstrin) c c *********************************************************************** c * * c * Subroutine AX - To get the axis data from the user * c * * c *********************************************************************** c Byte Label(2,80),Strin(Nstrin) c 10 Continue c c Ask the user to input the axis information c Write(6,100) (Strin(I),I=1,Nstrin) 100 Format(/' ',A1,' Axis information:'/' Enter the minimum,', $ ' maximum, and increment values:') Call Indata(3,'RRR',Amin,Amax,Ainc) c c Re-arrange the minimum and maximum values if necessary c If (Amin .GT. Amax) Then A = Amin Amin = Amax Amax = A Endif c c See if there is an error in the input values c If (Amax .EQ. Amin) Then c Write(6,200) c 200 Format(/' Error - minimum and maximum values are equal - ', $ 'Try Again') Go To 10 End If c If (Ainc .LE. 0.0 .OR. Ainc .LT. 0.001*(Amax - Amin)) Then Write(6,300) c 300 Format(/' Error - Increment value too small or negative - ', $ 'Try Again') c Go To 10 End If c c Get the axis title from the user c Write(6,400) (Strin(I),I=1,Nstrin) 400 Format(/' Input the ',A1,' Axis title: ') Call Axname(Label(1,1),0) c Return End Subroutine MODAX c c *********************************************************************** c * * c * Subroutine MODAX - To modify the current axis data. This * c * routine queries the user as to which parameter(s) to change. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Cmain' Include 'Caxis' Include 'Cflags' c Integer*4 Yesno(2) Character*9 Axnam(2) Data Yesno/'No ','Yes '/ Data Axnam/' Primary ','Secondary'/ c 10 Continue c c Re-set the scroll region to the entire screen c Write(6,200) 27 200 Format(1X,1A1,'[1;24r') c c Write out the current axis data c Call Displa c c Set the scroll region to the last two lines, and put the c curser on the bottom line c Write(6,300) 27,27 300 Format(1X,1A1,'[23;24r',1A1,'[24B') c c Ask the user if they want to / what they want to / change c 20 Continue Write(6,400) 400 Format(' Enter the number to change, or "S" to ', $ 'stop: ',$) c c Read in the number to change - see if the user wishes to c stop ( Iflag = 1 is returned if an "S" was input) c Call Inpt(X,Num,Iflag,2) c c Check for input errors c If (Num .NE. 1 .AND. Iflag .NE. 1) Then Write(6,450) 450 Format(' ERROR - Try again') Go To 20 Else If (Iflag .EQ. 1 .AND. Num .NE. 0) Then Write(6,450) Go To 20 Else If (Iflag .EQ. 1) Then !**** If user wants to stop, go to 50 Go To 50 End If c c See if the number to change exists (a number between 1 and 26) c If (X(1) .LT. 1.0 .OR. X(1) .GT. 26.0) Then Write(6,500) 500 Format(' ERROR - choice is out of range - Try Again ') Go To 20 End If c Num = X(1) Ipflag = 1 c c See if the choice will require a number input (as opposed c to a character string, etc.) c If ( Num .NE. 19 .AND. Num .NE. 20 .AND. Num .NE. $ 9 .AND. Num .NE. 10 .AND. Num .NE. 11 .AND. $ Num .NE. 12 .AND. Num .NE. 22) Then c c The new "Value" is a number - read it in c Write(6,550) 550 Format(' Enter the new value: '$) Call Indata(1,'R',Value) c c Assign the new number to the corresponding variable c Call Varmod(Num,Value,Iflag) If (Iflag .EQ. 1) Go To 20 c c If the secondary axes are chosen, the selection will c automatically toggle yes or no - no further input is needed c Else If (Num .EQ. 11) Then c Xnumbr = 3 - Xnumbr c Else If (Num .EQ. 12) Then c Ynumbr = 3 - Ynumbr c Else If (Num .EQ. 22) Then Xtop = 1 - Xtop Else c c Input of a new axis label c Write(6,750) 750 Format(' Edit the current axis title:') If (Num .EQ. 9) Then Call Axname(Xaxis(1,1),1) Else If (Num .EQ. 10) Then Call Axname(Yaxis(1,1),1) Else If (Num .EQ. 19) Then Call Axname(Xaxis(2,1),1) Else Call Axname(Yaxis(2,1),1) End If End If c c Go back and print out the new axis values c Go To 10 c 50 Continue c c Warn the user if the axis minumums and maximums, and c the increment values are not correct c Iflag = 0 c c Re-set the scroll region c Write(6,850) 27,27 850 Format(1X,1A1,'[1;24r',1A1,'[24;1H') c Do 60 I=1,Xnumbr If (Xmin(I) .GE. Xmax(I)) Then Write(6,900) 7,Axnam(I),'X' Iflag = 1 Else If (Xinc(I) .LE. 0.0 .OR. Xinc(I)/(Xmax(I)-Xmin(I)) .LT. $ 0.005) Then Write(6,950) 7,Axnam(I),'X' Iflag = 1 End If 60 Continue c Do 70 I=1,Ynumbr If (Ymin(I) .GE. Ymax(I)) Then Write(6,900) 7,Axnam(I),'Y' Iflag = 1 Else If (Yinc(I) .LE. 0.0 .OR. Yinc(I)/(Ymax(I)-Ymin(I)) .LT. $ 0.005) Then Write(6,950) 7,Axnam(I),'Y' Iflag = 1 End If 70 Continue c c c If (Iflag .EQ. 1) Call Spause c Return c 900 Format(' WARNING - ',A1,A9,1X,A1,' axis minimum greater ', $ 'than maximum value') 950 Format(' WARNING - ',A1,A9,1X,A1,' increment value too small') End Subroutine Axname(Axis,Iflag) c c *********************************************************************** c * * c *********************************************************************** c Byte Axis(2,1),Titl(80) If (Iflag .EQ. 1) Then Do 5 I=1,80 Titl(I) = Axis(1,I) 5 Continue Do 10 I=80,1,-1 If (Axis(1,I) .NE. ' ' .AND. Axis(1,I) .NE. 0) Go To 20 10 Continue 20 Nchars = I End If Call Linedt(Titl,Nchars,80,Iflag) Do 30 I=1,80 Axis(1,I) = ' ' If (Nchars .GE. I) Axis(1,I) = Titl(I) 30 Continue Return End Subroutine DISPLA c c *********************************************************************** c * * c * Subroutine DISPLA - To display the current axes values. * c * This routine only lists the data - no data values are * c * changed. If a secondary X and/or Y axis have been * c * selected, they will be displayed * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Caxis' Include 'Cgrid' c Integer*4 Yesno(2) Character*6 Top(2) c Data Yesno/'No ','Yes'/ Data Top/'Top ','Bottom'/ c c Clear the screen, and print a flashing header c Write(6,100) 27,27,27,27,27 100 Format(1X,1A1,'[H',1A1,'[J',T15,1A1,'#6',1A1,'[5mCURRENT AXIS', $ ' DATA:',1A1,'[0m'/) c c Print the primary axes minimums, maximums, and increments c Write(6,150) Xlen,Ylen,Xmin(1),Xmax(1),Xinc(1), $ Ymin(1),Ymax(1),Yinc(1) c 150 Format(' PRIMARY AXES:',5X,'1) X axis ', $ 'length: ',F6.3,10X,'2) Y axis length: ',F6.3// $ ' 3) X min: ',G11.5,3X,'4) ', $ 'X max: ',G11.5,3X,'5) X increment: ',G11.5/' 6) Y Min: ', $ G11.5,3X,'7) Y max: ',G11.5,3X,'8) Y increment: ',G11.5/) c c Print out the X and Y axis titles c Write(6,200) (Xaxis(1,I),I=1,60),(Yaxis(1,J),J=1,60) c 200 Format(' 9) X axis title: ',60A1/' 10) Y axis title: ',60A1/) c c Print out the secondary X and Y axis header c Write(6,225) Yesno(Xnumbr),Yesno(Ynumbr) 225 Format(' SECONDARY AXES:',12X, $ '11) X axis: ',A4,10X,'12) Y axis: ',A4/) c c Print out the secondary X and Y axis data (if it exists) c If (Xnumbr .EQ. 2 .AND. Ynumbr .EQ. 2) Then c c ************** Both axes: ************* c Write(6,250) Xmin(2),Xmax(2),Xinc(2),Ymin(2),Ymax(2),Yinc(2) Write(6,235) (Xaxis(2,I),I=1,60),(Yaxis(2,J),J=1,60) 235 Format(/' 19) X axis title: ',60A1/' 20) Y axis title: ', $ 60A1/) c Else If (Xnumbr .EQ. 2) Then c c ************* X axis only ************ c Write(6,300) 13,'X',Xmin(2),14,'X',Xmax(2),15,'X',Xinc(2),19, $ 'X',(Xaxis(2,I),I=1,60) Else If (Ynumbr .EQ. 2) Then c c ************* Y axis only ************ c Write(6,300) 16,'Y',Ymin(2),17,'Y',Ymax(2),18,'Y',Yinc(2),20, $ 'Y',(Yaxis(2,I),I=1,60) End If c 250 Format(' 13) X min: ',G11.5,2X,'14', $ ') X max: ',G11.5,2X,'15) X increment: ',G11.5/' 16) ', $ 'Y min: ',G11.5,2X,'17) Y max: ',G11.5,2X,'18) Y in', $ 'crement: ',G11.5) 300 Format( I3,') ',A1,' min: ',G11.5,2X, $ I2,') ',A1,' max: ',G11.5,2X,I2,') ',A1,' increment: ', $ G11.5//I3,') ',A1,' axis title: ',60A1/) c c Print the letter size, line thickness, symbol size, c and grid increments c If (Xnumbr .NE. 2) Then Write(6,350) Textsz 350 Format(' 21) Axes text size: ',I7) Else Write(6,400) Textsz,Top(Xtop+1) 400 Format(' 21) Axes text size: ',I7,13X, $ ' 22) Secondary X axis on ',A) End If c Write(6,450) Xgrdmj,Xgrdmr,Ygrdmj,Ygrdmr 450 Format(' 23) X grid major incr: ',G13.5,4X, $ ' 24) X grid minor incr: ',G13.5/ $ ' 25) Y grid major incr: ',G13.5,4X, $ ' 26) Y grid minor incr: ',G13.5/) c Return End Subroutine Varmod(Num,Value,Iflag) c c *********************************************************************** c * * c * Subroutine Varmod - To modify current axes values. This * c * routine only assigns a new value to the axes values - it * c * does not change the axes labels, or input the the new * c * value. If the new value is out of the range, Iflag is * c * set to 1 to notify the calling routine. * c * * c * Input values: * c * * c * Num - The number corresponding to the routine to change. * c * Value - The new number to change to * c * * c * Output values: * c * * c * Iflag - Error return Iflag = 0 no error * c * Iflag = 1 value out of range * c * * c * It shoud be noted that, the changed value is passed back * c * in the common block 'AXIS'. Only one value is changed per * c * call * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Include 'Caxis' Include 'Cgrid' c c Initialize the error flag (Iflag) to zero (No error) c Iflag = 0 c c If the value is an axis length, see if the value is acceptable c If (Num .LT. 3 .AND. (Value .LT. .01 .OR. Value .GT. 99)) $ Go To 20 c c See that if the value is less than zero, it is OK c If ((Num .EQ. 5 .OR. Num .EQ. 8 .OR. NUM .EQ. 18 .OR. Num .EQ. $ 15 .OR. Num .GE. 21) .AND. Value .LT. 0.0) Go To 20 c c Assign the value with the correct variable c If (Num .EQ. 1) Xlen = Value If (Num .EQ. 2) Ylen = Value If (Num .EQ. 3) Xmin(1) = Value If (Num .EQ. 4) Xmax(1) = Value If (Num .EQ. 5) Xinc(1) = Value If (Num .EQ. 6) Ymin(1) = Value If (Num .EQ. 7) Ymax(1) = Value If (Num .EQ. 8) Yinc(1) = Value If (Num .EQ. 13) Xmin(2) = Value If (Num .EQ. 14) Xmax(2) = Value If (Num .EQ. 15) Xinc(2) = Value If (Num .EQ. 16) Ymin(2) = Value If (Num .EQ. 17) Ymax(2) = Value If (Num .EQ. 18) Yinc(2) = Value If (Num .EQ. 21) Then If (Value .GT. 20) Go To 20 Textsz = Value End If If (Num .EQ. 23) Xgrdmj = Value If (Num .EQ. 24) Xgrdmr = Value If (Num .EQ. 25) Ygrdmj = Value If (Num .EQ. 26) Ygrdmr = Value c Return c 20 Continue c c Error flag set to 1 (value not acceptable for the variable) c Write(6,600) 7 600 Format(' ERROR - Input value is unacceptable - Try Again',1A1) Iflag = 1 c Return End