Subroutine MAKEAX c c *********************************************************************** c * * c * Subroutine MAKEAX - To set up and draw the axes for the * c * 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 Byte Titl(80) c Dimension Siznum(10) Integer Spchar,Atxclr,Xtop Double Precision Xvalue,Yvalue,Val c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxi,Yaxi,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr Common/Grid/Xgrdmj,Xgrdmr,Ygrdmj,Ygrdmr,Thikmj,Thikmr,Grdcmj, $Grdcmr Common/Center/Xpmin,Xpmax,Ypmin,Ypmax,Xorg,Yorg,Xplotl,Yplotl c Data Siznum/4*.0312,3*0.0328,2*0.0312,0.0375/ c c Set the line thickness and colors c Call Stlthc(Axthik) Call Staxco(Axcolr) Call Sttxco(Atxclr) Call Stplco(Axcolr) c c Set up the axis text style c If (Axchst .GT. 0) Then Call Stsoft Call Stcstn(Axchst) If(Spchar .GT. 1) Call Stcspa(1,0,0) Else Call Sthard End If c c See if there really is to be axes c If (Axthik .EQ. 0.0 .AND. Textsz .EQ. 0.0) Return c c Set up the axis text size c Call Stccsz(Textsz*0.03,Textsz*0.042) Call Gtccsz(Xsiz,Ysiz) Xsiz = Xsiz * (Xmax(1)-Xmin(1))/Xlen Ysiz = Ysiz * (Ymax(1)-Ymin(1))/Ylen c c Set up the primary window c Call Plwin(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) c c Set up grids if there are log axes: c Icode = 0 If (Xgrdmj .NE. 0.0 .AND. Axtypx .EQ. 2) Icode = 1 If (Xgrdmr .NE. 0.0 .AND. Axtypx .EQ. 2) Icode = 5 If (Ygrdmj .NE. 0.0 .AND. Axtypy .EQ. 2) Icode = Icode + 2 If (Ygrdmr .NE. 0.0 .AND. Axtypy .EQ. 2) Icode = Icode + 8 If (Ygrdmr .NE. 0.0 .AND. Axtypy .EQ. 2 .AND. Ygrdmj .EQ. 0.0) $ Icode = Icode + 2 c c Set up for outward tick marks c If (Ticdir .NE. 3) Then Call Stkatt(Ticdir,Icode,1) Else Call Stkatt(1,Icode,1) c Ticdir = 1 Call Stksiz(0.0,0.0) End If c If (Ticdir .NE. 2) Then Deltx = 0.0 Delty = 0.0 Else Deltx = Yplotl/80./Ylen*(Ymax(1)-Ymin(1)) Delty = Xplotl/80./Xlen*(Xmax(1)-Xmin(1)) End If c c Set up the tick marks for the normal X axis c If (Axtypx .EQ. 1) Then Xincre = Xinc(1) 10 Continue Call Inc(Xmin(1),Xmax(1),Xincre,Isfig,Ideci) Call Comcnt(Xmin(1),Xmax(1),Xincre,Icom) c c Compute the length of the axis numbers c If (Axchst .EQ. 0) Then Alen = Xsiz * 1.4 * (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(1)-Xmin(1)) Else Alen = 0.0375*(Isfig+Ideci+2.0+Icom) * Textsz Alen = Alen/Xlen*(Xmax(1)-Xmin(1)) End If c c Get the length of the increment needed to fit the numbers c If (Alen .GT. Xincre) Then Xincre = Xincre * 2.0 Call Tikchk(Xincre,Xinc(1)) Go To 10 End If c c Set the X tick marks c Call Stticx(Xincre,Xinc(1)) c c Compute the leftmost axis point to number c Xmn = Jint((Xmin(1)-Xincre/100.)/Xincre)*Xincre If (Xmin(1) .GT. 0.0) Xmn = Xmn + Xincre Xmn1 = Jint((Xmin(1)-Xinc(1)/100.)/Xinc(1))*Xinc(1) If (Xmin(1) .GT. 0.0) Xmn1 = Xmn1 + Xinc(1) Else Call Stlogx Xmn = Xmin(1) End If c c Draw the X axis and tick marks c If (Axthik .GT. 0.0) Then Call Xaxis(Xmn,Xmax(1),Ymin(1)) If (Xmn .GT. Xmin(1) + 0.5 * Xinc(1) .AND. Axtypx .EQ. 1) Then Call Xaxis(Xmn1,Xmn,Ymin(1)) End If End If c Axx = Axthik/Xlen * (Xmax(1) - Xmin(1)) * Chscal Axy = Axthik/Ylen * (Ymax(1) - Ymin(1)) * Chscal If (Textsz .EQ. 0.0) Go To 30 c c Number the X axis: c If (Axtypx .EQ. 1) Then c c For a normal X axis; c Xvalue = Xmn Xmx = Xmax(1) + 0.005 * Xincre Call Inc(Xincre,Xincre,Xincre,Isfig,Ideci) Call Stjust(8) Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) 7 Continue Xv = Xvalue If (Xv .GT. Xmx) Go To 9 Call Inc(Xv,Xv,Abs(Xv),Isfig,Id) If (Id .EQ. 0 .AND. Ideci .GT. 0) Isfig = Isfig + 1 c c Make 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 V = Abs(Xvalue/(10.0**(Isfig-6))) V = Jint(V + 0.5) * Xvalue/Dabs(Xvalue) Encode(7,113,Titl) V 113 Format(F<7>.0) Do 8 K=7,Isfig Titl(K) = '0' 8 Continue End If End If c c Write out the number character string c Call Movawc(Xv,Ymin(1) - 0.8*Ysiz - Deltx - $ Axy/2.0) 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 c Else c c For a logarithmic X axis; c Call Stlfmt(2,0) Call Xvlab(Xmn,Xmax(1),Ymin(1)-Axy/2.0 + Ysiz*0.5) Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) Call Stjust(8) End If c c Find the length of the axis label c Call Getl(Xaxi(1,1),1,Ixlen,Titl) Call Strn(Titl,Ixlen,Axchst) c c Write out the axis label c If (Axtypx .EQ. 1) Then Call Movawc((Xmin(1)+Xmax(1))/2.0,Ymin(1)-Deltx-2.6* $ Ysiz-Axy/2.0) Else Call Movawc((Xmin(1)+Xmax(1))/2.0,Ymin(1)-Deltx-3.5* $ Ysiz-Axy/2.0) End If Call Grtxcp(Ixlen,Titl) c c Now for the Y axis: c 30 Continue c c Compute the Y axis tick increments c Call Plwin(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) c If (Axtypy .EQ. 1) Then Yincre = Yinc(1) 40 Continue If (Ysiz .LE. Yincre/3.0) Go To 50 Yincre = Yincre * 2.0 Call Tikchk(Yincre,Yinc(1)) Go To 40 50 Continue c c Set the Y axis tick marks c Call Stticy(Yincre,Yinc(1)) c c Compute the axis lower corner c Ymn = Jint((Ymin(1)-Yincre/100.)/Yincre)*Yincre If (Ymin(1) .GT. 0.0) Ymn = Ymn + Yincre Ymn1 = Jint((Ymin(1)-Yinc(1)/100.)/Yinc(1))*Yinc(1) If (Ymin(1) .GT. 0.0) Ymn1 = Ymn1 + Yinc(1) Else Call Stlogy Ymn = Ymin(1) End If c c Draw the Y axis and tick marks c If (Axthik .GT. 0.0) Then Call Yaxis(Ymn,Ymax(1),Xmin(1)) If (Ymn .GT. Ymin(1) + 0.5 * Yinc(1) .AND. Axtypy .EQ. 1) Then Call Yaxis(Ymn1,Ymn,Xmin(1)) End If 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(1) + 0.005 * Yincre Call Inc(Yincre,Yincre,Yincre,Isfig,Ideci) Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) Call Stjust(6) 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 the number text string 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 V = Abs(Yvalue/(10.0**(Isfig-6))) V = Jint(V + 0.5) * Yvalue/Dabs(Yvalue) Encode(7,113,Titl) V Do 18 K=7,Isfig Titl(K) = '0' 18 Continue End If End If c c Adjust the vertical location so it won't hit c the X axis numbers c If (Ticdir .EQ. 2) Then Yloc = 0.0 Else If (Yv-Yincre/1000. .LT. Ymin(1) .AND. Axtypx .EQ. 1) Then Yloc = Ysiz * 0.1 Else If (Yv+Yincre/1000. .GT. Ymax(1) .AND. Xnumbr .EQ. 2) Then Yloc = -Ysiz * 0.1 Else Yloc = 0.0 End If c c Write out the number text string c Call Movawc(Xmin(1) - 1.0*Xsiz - Delty - Axx/2.0,Yv+Yloc) Call Comma(Titl,Yv,Isfig,Ideci,Ilen) Call Grtxcp(Ilen,Titl) Yvalue = Yvalue + Yincre Go To 17 19 Continue c Else c c For logarithmic Y axis; c Call Stlfmt(2,0) Call Yvlab(Ymn,Ymax(1),Xmin(1) - 1.0 * $ Xsiz/2.0 - Axx/2.0) Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) Call Stjust(6) End If c c Get the Y axis label c Call Getl(Yaxi(1,1),1,Iylen,Titl) Call Strn(Titl,Iylen,Axchst) c c Compute the location for the Y axis label c If (Axtypy .EQ. 1) Then c c For a normal Y axis; c Call Inc(Ymn,Ymax(1),Yincre,Isfig,Ideci) Call Comcnt(Ymn,Ymax(1),Yincre,Icom) If (Axchst .EQ. 0) Then Ypos = (Ideci + Isfig + 2.9 + Icom)*Xsiz*1.5 + Delty Else If (Spchar .GT. 1) Then Ypos = (Siznum(Axchst)*(Isfig+Ideci+ 2.9) + $ Icom*0.0165) * Textsz If (Ideci .GT. 0) Ypos = Ypos + (0.0165 - $ Siznum(Axchst))*Textsz Ypos = Ypos/Xlen*(Xmax(1)-Xmin(1)) + Delty Else Ypos = 0.0375*(Isfig+Ideci+2.9+Icom) * Textsz Ypos = Ypos/Xlen*(Xmax(1)-Xmin(1)) + Delty End If Call Movawc(Xmin(1)-Ypos $ -Axx/2.0,(Ymin(1)+Ymax(1))/2.0) Else c c For a logarithmic Y axis; c If (Axchst .EQ. 0) Then Ypos = 1.4 * 8.0 * Xsiz + Delty Else If (Spchar .EQ. 2) Then Ypos = 5.5 * Siznum(Axchst)/ $ Xlen*(Xmax(1)-Xmin(1)) * Textsz + Delty Else Ypos = 5.5 * 0.0375 * Textsz/ $ Xlen * (Xmax(1)-Xmin(1)) + Delty End If Call Movawc(Xmin(1)-Ypos-Axx/2.0, $ (Ymin(1)+Ymax(1))/2.0) End If c c Move to the location for the Y label, rotate 90 degrees c Call Stcrot(90.0) Call Stjust(2) c c Write the Y axis Label c Call Grtxcp(Iylen,Titl) c Call Stcrot(0.0) ! rotate back 90 degrees c Return End Subroutine BOX c c *********************************************************************** c * * c * Subroutine BOX - To draw a "box" around the polt axes area. * c * This subroutine is used to eliminate problems caused by the * c * Text block and legends, when their borders are turned off * c * and they share a common edge with the axes border. * 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 Xboard(5),Yboard(5) Integer Spchar,Atxclr,Xtop c Common/Ptype/Idev,Xtop,Spchar,Chscal Common/Axis/Xmin,Xmax,Ymin,Ymax,Xinc,Yinc,Xlen,Ylen,Xnumbr, $ Ynumbr,Xaxi,Yaxi,Axthik,Axchst,Axtypx,Axtypy,Axcolr,Textsz, $ Ticdir,Atxclr c c Set the line thickness and colors c Call Stlthc(Axthik) Call Stplco(Axcolr) c If (Axthik .EQ. 0.0) Return c Call Plcord(Xmin(1),Xmax(1),Ymin(1),Ymax(1),Xlen,Ylen) c c Box the plot in c Xboard(1) = Xmin(1) Xboard(2) = Xmax(1) Xboard(3) = Xmax(1) Xboard(4) = Xmin(1) Xboard(5) = Xmin(1) Yboard(1) = Ymin(1) Yboard(2) = Ymin(1) Yboard(3) = Ymax(1) Yboard(4) = Ymax(1) Yboard(5) = Ymin(1) Call Wccurv(Xboard,Yboard,5) c Return End