Subroutine MAKE2X c c *********************************************************************** c * * c * Subroutine MAKE2X - To set up and draw the secondary axes * c * for the plot. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Dimension Xmin(2),Ymin(2),Xmax(2),Ymax(2),Xinc(2),Yinc(2) Integer Xnumbr,Ynumbr,Axchst,Axtypx,Axtypy,Axcolr,Ticdir Byte Xaxi(2,80),Yaxi(2,80) c Dimension Siznum(10),Xx(2),Yy(2) Byte Titl(80) Integer Xn,Yn Double Precision Xvalue,Yvalue!,Val c Integer Spchar,Atxclr,Xtop c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Labls/Nlab,Lachst,Lacolr,Nleg,Lechst,Lecolr,Legtit,Labcrd, $ Iprtot Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxi,Yaxi,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr Common/Center/Xpmin,Xpmax,Ypmin,Ypmax,Xorg,Yorg,Xplotl,Yplotl c Data Siznum/4*0.0312,3*0.0328,2*0.0312,0.0375/ c c See if there is a secondary axes c If (Xnumbr .LE. 1 .AND. Ynumbr .LE. 1) Return If (Axthik .EQ. 0.0 .AND. Textsz .EQ. 0.0) Return c c Set up the axis text size (character set and color set in c Makeax) c Xn = Xnumbr Yn = Ynumbr Axx = Axthik/Xlen * (Xmax(Xn) - Xmin(Xn)) * Chscal Axy = Axthik/Ylen * (Ymax(Yn) - Ymin(Yn)) * Chscal c c Get the size of the text c Call Gtccsz(Xsiz,Ysiz) Xsiz = Xsiz * (Xmax(Xn)-Xmin(Xn))/Xlen Ysiz = Ysiz * (Ymax(Yn)-Ymin(Yn))/Ylen c c Set up the secondary axis window c Call Plwin(Xmin(Xn),Xmax(Xn),Ymin(Yn),Ymax(Yn),Xlen,Ylen) c c Set parameters depending on the tick mark direction c If (Ticdir .NE. 3) Then Dx = Yplotl/80./Ylen*(Ymax(Yn)-Ymin(Yn)) Else Dx = 0.0 End If c Call Stkatt(Ticdir,0,1) If (Ticdir .NE. 2) Then Deltx = 0.0 Delty = 0.0 Else Deltx = Yplotl/80./Ylen*(Ymax(Yn)-Ymin(Yn)) Delty = Xplotl/80./Xlen*(Xmax(Xn)-Xmin(Xn)) End If c c For axis on plot bottom; c If (Xtop .EQ. 1) Then Call Getl(Xaxi(1,1),1,Ixlen,Titl) Call Supsub(Titl,Ixlen,Iup,Idown) Adown = 0.4 * Idown If (Axtypx .EQ. 1) Then Yloc = Ymin(Yn)-(2.6+2.3+Adown)*Ysiz-Axy/2.0-Dx Else Yloc = Ymin(Yn)-(3.5+2.3+Adown)*Ysiz-Axy/2.0-Dx End If Else Yloc = Ymax(Yn) End If c c Secondary X axis: c If (Xnumbr .EQ. 2) Then c If (Axtypx .EQ. 1) Then c c Set up the tick marks for the normal X axis c Xincre = Xinc(2) 10 Continue Call Inc(Xmin(2),Xmax(2),Xincre,Isfig,Ideci) Call Comcnt(Xmin(2),Xmax(2),Xincre,Icom) c c Determine the length of the axis numbers c If (Axchst .EQ. 0) Then Alen = 1.4 * Xsiz*(Isfig + Ideci + 2 * (1.0 + Icom)) Else If (Spchar .GT. 1) Then Alen = (Siznum(Axchst)*(Isfig+Ideci+2.0) + Icom * $ 0.0165) *Textsz If (Ideci .GT. 0) Alen = Alen + (0.0165-Siznum(Axchst)) $ *Textsz Alen = Alen/Xlen*(Xmax(2)-Xmin(2)) Else Alen = 0.0375*(Isfig+Ideci+2.0+Icom)*Textsz Alen = Alen/Xlen*(Xmax(2)-Xmin(2)) End If c c Compare the length of the numbers to the c tick mark spacing c If (Alen .GT. Xincre) Then Xincre = Xincre * 2.0 Call Tikchk(Xincre,Xinc(2)) Go To 10 End If c c Set the X tick marks c Call Stticx(Xincre,Xinc(2)) c c Compute the starting point to number the axis at c Xmn = Jint((Xmin(2)-Xincre/100.)/Xincre)*Xincre If (Xmin(2) .GT. 0.0) Xmn = Xmn + Xincre Xmn1 = Jint((Xmin(2)-Xinc(2)/100.)/Xinc(2))*Xinc(2) If (Xmin(2) .GT. 0.0) Xmn1 = Xmn1 + Xinc(2) Else Call Stlogx Xmn = Xmin(2) End If c c Draw the axis and tick marks c Call Xaxis(Xmn,Xmax(2),Yloc) If (Xtop .EQ. 0) Then If (Xmn .GT. Xmin(2) + 0.5*Xinc(2) .AND. Axtypx .EQ. 1) Then Call Xaxis(Xmn1,Xmn,Yloc) End If Else If (Xmn .GT. Xmin(2) .AND. Axtypx .EQ. 1) Then Call Xaxis(Xmin(2),Xmn,Yloc) End If End If If (Textsz .EQ. 0.0) Go To 30 c c Number the the X axis c Call Stjust(2+Xtop*6) If (Axtypx .EQ. 1) Then c c For a normal axis; c Xvalue = Xmn Xmx = Xmax(2) + 0.005 * Xincre Call Inc(Xincre,Xincre,Xincre,Isfig,Ideci) Call Plcord(Xmin(2),Xmax(2),Ymin(Yn),Ymax(Yn),Xlen,Ylen) 7 Continue Xv = Xvalue If (Xv .GT. Xmx) Go To 9 Call Inc(Xv,Yv,Abs(Xv),Isfig,Id) If (Id .EQ. 0 .AND. Ideci .GT. 0) Isfig = Isfig + 1 c c Create a character string of the number c If (Ideci .GT. 0) Then Encode(Isfig+Ideci,111,Titl) Xvalue 111 Format(F.) If (Xv .LT. 1.0 .AND. Xv .GE. 0.0) Then Titl(1) = '0' Else If (Xv .GT. -1.0 .AND. Xv .LT. 0.0) Then Titl(1) = '-' Titl(2) = '0' End If Else If (Isfig .LE. 6) Then Encode(Isfig+1,112,Titl) Xvalue 112 Format(F.0) Else Val = Abs(Xvalue/(10.0**(Isfig-6))) Val = Jint(Val + 0.5) * Xvalue/Dabs(Xvalue) Encode(7,113,Titl) Val 113 Format(F<7>.0) Do 8 K=7,Isfig Titl(K) = '0' 8 Continue End If End If c c Write out the character string c If (Xtop .EQ. 0) Then Call Movawc(Xv,Yloc+Ysiz*0.8+Deltx+Axy/2.0) Else Call Movawc(Xv,Yloc-0.8*Ysiz-Deltx-Axy/2.0) End If Call Comma(Titl,Xv,Isfig,Ideci,Ilen) If (Xv .EQ. 0.0 .AND. Ideci .EQ. 0) Then Call Grtxcp(1,'0') Else Call Grtxcp(Ilen,Titl) End If Xvalue = Xvalue + Xincre Go To 7 c 9 Continue Xpos = 0.0 c Else c c For a logarithmic axis; c Call Stlfmt(2,0) c Call Stjust(2) If (Xtop .EQ. 0) Then Call Xvlab(Xmn,Xmax(2),Yloc+Ysiz*3.4+2.0*Deltx+Axy/2.0) Else Call Xvlab(Xmn,Xmax(2),Yloc-Axy/2.0+Ysiz*0.5) End If Call Plcord(Xmin(Xn),Xmax(Xn),Ymin(Yn),Ymax(Yn),Xlen,Ylen) Xpos = 0.7 End If c c Find the length of the X axis label c Call Getl(Xaxi(1,1),2,Ixlen,Titl) Call Strn(Titl,Ixlen,Axchst) c c Write out the X axis label c If (Xtop .EQ. 0) Then Call Movawc((Xmin(2)+Xmax(2))/2.0,Ymax(Yn)+ $ (3.0 + Xpos)*Ysiz+Axy/2.0+Deltx) Else If (Axtypx .EQ. 1) Then Call Movawc((Xmin(2)+Xmax(2))/2.0,Yloc-Deltx-2.6*Ysiz- $ Axy/2.0) Else Call Movawc((Xmin(2)+Xmax(2))/2.0,Yloc-Deltx-3.5*Ysiz- $ Axy/2.0) End If End If Call Grtxcp(Ixlen,Titl) End If If (Xtop .EQ. 1) Then Xx(1) = Xmin(2) Xx(2) = Xmax(2) Yy(1) = Yloc Yy(2) = Yloc Call Wccurv(Xx,Yy,2) End If Call Plwin(Xmin(Xn),Xmax(Xn),Ymin(Yn),Ymax(Yn),Xlen,Ylen) c c If There is a secondary Y axis: c 30 Continue c c **************** Now for the Y axis: ************* c If (Ynumbr .EQ. 2) Then c If (Axtypy .EQ. 1) Then c c Get a tick size big enough for the letters c Yincre = Yinc(2) 40 Continue If (Ysiz .LE. Yincre/3.0) Go To 50 Yincre = Yincre * 2.0 Call Tikchk(Yincre,Yinc(2)) Go To 40 50 Continue c c Set the Y axis tick marks c Call Stticy(Yincre,Yinc(2)) c c Get the minimum Y value at a normal increment c Ymn = Jint((Ymin(2)-Yincre/100.)/Yincre)*Yincre If (Ymin(2) .GT. 0.0) Ymn = Ymn + Yincre Ymn1 = Jint((Ymin(2)-Yinc(2)/100.)/Yinc(2))*Yinc(2) If (Ymin(2) .GT. 0.0) Ymn1 = Ymn1 + Yinc(2) Else Call Stlogy Ymn = Ymin(2) End If c c Draw the Y axis c Call Yaxis(Ymn,Ymax(2),Xmax(Xn)) If (Ymn .GT. Ymin(2) + 0.5 * Yinc(2) .AND. Axtypy .EQ. 1) Then Call Yaxis(Ymn1,Ymn,Xmax(Xn)) End If If (Textsz .EQ. 0.0) Return c c Number the Y axis c If (Axtypy .EQ. 1) Then c c For a normal Y axis; c Yvalue = Ymn Ym = Ymax(2) + 0.005 * Yincre Ymx = Jint((Ymax(2)-Ymn+Yincre/10000.)/Yincre)*Yincre $ + Ymn Call Inc(Ymn,Ymx,Yincre,Isfig,Ideci) Call Comcnt(Ymn,Ymax(2),Yincre,Icom) c c Get the X locations of the numbers and axis c title, from the right side of the plot c If (Axchst .EQ. 0) Then Ypos = (Ideci+Isfig+1.5+Icom+Ticdir)*Xsiz*1.2+Delty Ypost = 2.0*Xsiz Else If (Spchar .GT. 1) Then Ypos = (Siznum(Axchst)*(Isfig+Ideci+1.2) + $ Icom * 0.0165) * Textsz If (Ideci .GT. 0) Ypos = Ypos + (0.0165 - $ Siznum(Axchst)) * Textsz Ypos = Ypos/Xlen*(Xmax(Xn)-Xmin(Xn)) + Delty Ypost = Siznum(Axchst)*Textsz*1.9/Xlen*(Xmax(Xn)- $ Xmin(Xn)) Else Ypos = 0.0375*(Isfig+Ideci+1.2+Icom) * Textsz Ypos = Ypos/Xlen*(Xmax(Xn)-Xmin(Xn)) + Delty Ypost = Siznum(Axchst)*Textsz*1.9/Xlen*(Xmax(Xn)- $ Xmin(Xn)) End If c Call Inc(Yincre,Yincre,Yincre,Isfig,Ideci) Call Plcord(Xmin(Xn),Xmax(Xn),Ymin(2),Ymax(2),Xlen,Ylen) Call Stjust(6) c c Number the Y axis c 17 Continue Yv = Yvalue If (Yv .GT. Ym) Go To 19 Call Inc(Yv,Yv,Abs(Yv),Isfig,Id) If (Id .EQ. 0 .AND. Ideci .GT. 0) Isfig = Isfig + 1 c c Create a character string of the number c If (Ideci .GT. 0) Then Encode(Isfig+Ideci,111,Titl) Yvalue If (Yv .LT. 1.0 .AND. Yv .GE. 0.0) Then Titl(1) = '0' Else If (Yv .GT. -1.0 .AND. Yv .LT. 0.0) Then Titl(1) = '-' Titl(2) = '0' End If Else If (Isfig .LE. 6) Then Encode(Isfig+1,112,Titl) Yvalue Else Val = Abs(Yvalue/(10.0**(Isfig-6))) Val = Jint(Val + 0.5) * Yvalue/Dabs(Yvalue) Encode(7,113,Titl) Val Do 18 K=7,Isfig Titl(K) = '0' 18 Continue End If End If c c Adjust the Y axis numbers so they won't interfere c with the X axis numbers c If (Ticdir .EQ. 2) Then Yloc = 0.0 Else If (Yv - Yincre/1000. .LT. Ymin(2)) Then Yloc = Ysiz * 0.1 Else If (Yv + Yincre/1000. .GT. Ymax(2) .AND. Xnumbr $ .EQ. 2 .AND. Axtypx .EQ. 1) Then Yloc = -Ysiz * 0.1 Else Yloc = 0.0 End If c c Write out the number character string c Call Movawc(Xmax(Xn)+Ypos+Axx/2.0,Yv+Yloc) Call Comma(Titl,Yv,Isfig,Ideci,Ilen) Call Grtxcp(Ilen,Titl) Yvalue = Yvalue + Yincre Go To 17 19 Continue Else c c For a logarithmic Y axis; c Call Stlfmt(2,0) c c Get the X locations of the numbers and axis c title, from the right side of the plot c If (Axchst .EQ. 0) Then Ypos = 1.5 * 0.5 * Xsiz Ypost = 6.5 * Xsiz * 1.5 Else If (Spchar .GT. 1) Then Ypos = 0.5 * Siznum(Axchst)*Textsz/ $ Xlen*(Xmax(Xn)-Xmin(Xn)) Ypost = 5.7 * Siznum(Axchst)*Textsz/ $ Xlen*(Xmax(Xn)-Xmin(Xn)) + Delty Else Ypos = 0.5 * 0.0375 * Textsz/ $ Xlen*(Xmax(Xn)-Xmin(Xn)) Ypost = 5.7 * 0.0375 * Textsz/ $ Xlen*(Xmax(Xn)-Xmin(Xn)) + Delty End If c c Number the Y axis c Call Yrvlab(Ymn,Ymax(2),Xmax(Xn)+Ypos+Axx/2.0) Ypos = 0.0 Call Plcord(Xmin(Xn),Xmax(Xn),Ymin(Yn),Ymax(Yn),Xlen,Ylen) End If c c Get the Y axis label c Call Getl(Yaxi(1,1),2,Iylen,Titl) Call Strn(Titl,Iylen,Axchst) c c Move to the location for the label, and rotate 90 degrees c Call Movawc(Xmax(Xn)+Ypos+Ypost+ $ Axx/2.0,(Ymin(2)+Ymax(2))/2.0) c Call Stcrot(90.0) Call Stjust(8) c c Write the Y axis Label c Call Grtxcp(Iylen,Titl) c Call Stcrot(0.0) c End If c Return End Subroutine GRIDD c c *********************************************************************** c * * c * Subroutine GRIDD - To draw the grid on the plot. * c * If Xgrid and Ygrid are zero, no grid is drawn * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Dimension Xmin(2),Ymin(2),Xmax(2),Ymax(2),Xinc(2),Yinc(2) Integer Xnumbr,Ynumbr,Textsz,Axchst,Axtypx,Axtypy,Axcolr,Ticdir Byte Xaxis(2,80),Yaxis(2,80) Byte Titl(80) c Integer Grdcmj,Grdcmr c c Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir Common/Grid/Xgrdmj,Xgrdmr,Ygrdmj,Ygrdmr,Thikmj,Thikmr,Grdcmj, $Grdcmr c c Set the window coordinates c Call Plwin(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) c c MAJOR AXIS: c Call Stplco(Grdcmj) Call Stlthc(Thikmj) c c Compute Xmn,Ymn c If (Xgrdmj .GT. 0.0 .AND. Xgrdmj/(Xmax(1)-Xmin(1)) .GT. 5.0E-4) $ Then Xmn = Jint((Xmin(1)-Xgrdmj/100.)/Xgrdmj) * Xgrdmj If (Xmin(1) .LE. 0.0) Xmn = Xmn - Xgrdmj Else If (Xgrdmr .GT. 0.0 .AND. Xgrdmr/(Xmax(1)-Xmin(1)) .GT. $ 5.0E-4) Then Xmn = Jint((Xmin(1)-Xgrdmr/100.)/Xgrdmr) * Xgrdmr If (Xmin(1) .LE. 0.0) Xmn = Xmn - Xgrdmr Else Xmn = Xmin(1) End If c If (Ygrdmj .GT. 0.0 .AND. Ygrdmj/(Ymax(1)-Ymin(1)) .GT. 5.0E-4) $ Then Ymn = Jint((Ymin(1)-Ygrdmj/100.)/Ygrdmj) * Ygrdmj If (Ymin(1) .LE. 0.0) Ymn = Ymn - Ygrdmj Else If (Ygrdmr .GT. 0.0 .AND. Ygrdmr/(Ymax(1)-Ymin(1)) .GT. $ 5.0E-4) Then Ymn = Jint((Ymin(1)-Ygrdmr/100.)/Ygrdmr) * Ygrdmr If (Ymin(1) .LE. 0.0) Ymn = Ymn - Ygrdmr Else Ymn = Ymin(1) End If c Call Grd(Xgrdmj,Ygrdmj,Xmn,Ymn,1,1) c c MINOR AXIS: c c Determine how many minor grid lines fall inside the c major grid lines - this is used to keep the minor grid c lines from being drawn on top of the major grid lines - c important if they are of different colors c Ix = 1 If (Xgrdmr .GT. 0.0) Then Ix = Jint((Xgrdmj+0.01*Xgrdmr)/Xgrdmr) If (Abs(Jint(Xgrdmj/Xgrdmr + 1E-5) - Xgrdmj/Xgrdmr) .GT. 1E-3) $ Then Ix = 1 Xmn = Jint((Xmin(1)-Xgrdmr/100.)/Xgrdmr) * Xgrdmr If (Xmin(1) .LE. 0.0) Xmn = Xmn - Xgrdmr End If End If Iy = 1 If (Ygrdmr .GT. 0.0) Then Iy = Jint((Ygrdmj+0.01*Ygrdmr)/Ygrdmr) If (Abs(Jint(Ygrdmj/Ygrdmr + 1E-5) - Ygrdmj/Ygrdmr) .GT. 1E-3) $ Then Iy = 1 Ymn = Jint((Ymin(1)-Ygrdmr/100.)/Ygrdmr) * Ygrdmr If (Ymin(1) .LE. 0.0) Ymn = Ymn - Ygrdmr End If End If c Call Stplco(Grdcmr) Call Stlthc(Thikmr) Call Grd(Xgrdmr,Ygrdmr,Xmn,Ymn,Ix,Iy) Return End c Subroutine GRD(Xgrid,Ygrid,Xmn,Ymn,Ixcnt,Iycnt) c Dimension Xmin(2),Ymin(2),Xmax(2),Ymax(2),Xinc(2),Yinc(2) Integer Xnumbr,Ynumbr,Textsz,Axchst,Axtypx,Axtypy,Axcolr,Ticdir Byte Xaxis(2,80),Yaxis(2,80) c Dimension Xx(2),Yy(2) c Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxis,Yaxis,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir c c See if there is an X grid c If (Xgrid .GT. 0.0 .AND. Axtypx .EQ. 1) Then c If ((Xmax(1)-Xmn)/Xgrid .GT. 2000.0) Then Nline = 0 Else Nline = Jint((Xmax(1)-Xmn)/Xgrid - 0.001) End If c If (Nline .GT. 0) Then c Yy(1) = Ymin(1) Yy(2) = Ymax(1) c Do 10 I=1,Nline If ( (I/Ixcnt)*Ixcnt .EQ. I .AND. Ixcnt .GT. 1) Go To 10 c c Compute the ends of a grid line c Xx(1) = Xmn + Xgrid*I If (Xx(1) .LT. Xmin(1) + 1E-4 * Xgrid) Go To 10 Xx(2) = Xx(1) Call Wccurv(Xx,Yy,2) Yhold = Yy(1) Yy(1) = Yy(2) Yy(2) = Yhold 10 Continue End If End If c c See if there is a Y grid c If (Ygrid .GT. 0.0 .AND. Axtypy .EQ. 1) Then c If ((Ymax(1)-Ymn)/Ygrid .GT. 2000.0) Then Nline = 0 Else Nline = Jint((Ymax(1)-Ymn)/Ygrid - 0.001) End If c If (Nline .GT. 0) Then c Xx(1) = Xmin(1) Xx(2) = Xmax(1) c Do 20 I=1,Nline If ( (I/Iycnt)*Iycnt .EQ. I .AND. Iycnt .GT. 1) Go To 20 c c Compute the ends of a grid line c Yy(1) = Ymn + Ygrid*I If (Yy(1) .LT. Ymin(1) + 1E-4 * Ygrid) Go To 20 Yy(2) = Yy(1) Call Wccurv(Xx,Yy,2) Xhold = Xx(1) Xx(1) = Xx(2) Xx(2) = Xhold 20 Continue End If End If Return End