SUBROUTINE AXES(X0,Y0,ANGLE,V0,DV,DL,NMAJ,NMIN,NFRAC, 1 TITLE,NCHRS,SIZE,JUST) C C This subroutine will draw and annotate a linear axis C as described by the input variables. C C X0,Y0 Location of the "origin" in scale inches relative C to the relocable origin. C ANGLE Angle in degrees of the axis with respect to a C rightward going horizontal, positive angle being C in the counterclockwise direction. C V0 Value of the axis at the "origin". C DV Change in value per major division. C DL Length of major divisions in scale inches. C NMAJ Number of major divisions. C NMIN Number of minor divisions per major division. C NFRAC Number of fractional digits in annotation. If C NFRAC < 1, no decimal point will be printed. C TITLE Character string containing the title. C NCHRS In absolute value, the number of characters in the C title. If positive, the annotation is to the C left of the axis (typical Y); if negative, to the C right (typical X). C SIZE Character size in scale inches for annotation. The C title will be 1.5*SIZE. C JUST Optional character specifying the justification C of the lines in the TITLE; Default: 'C'. C C Notes: Assuming an X axis to be at either 0 or 180 degrees and a C Y axis to be at +/-90 degrees, this subroutine will also set the C appropriate variables in COMMON /PSTN/ to allow calls to either C SUBROUTINE PSTN or SUBROUTINE NTSP. These two subroutines provide C an easy method of scaling and unscaling data. C COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax, 1 Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3, 1 CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj COMMON /PSTN/ XZero, XScale, LogX, 1 YZero, YScale, LogY, YMin COMMON /AXESC/ CS, SN, SGN, TX, TY, DX, DY, 1 MIN, MIDL, MAX, MIDU, UMAX, WMAX, IFORM, JUSTFY LOGICAL LogX, LogY C C - IF NO PLOTTING IS TO BE DONE, RETURN. IF( IDEV .EQ. 0 ) RETURN NARG = 0 CALL NUMARG( NARG ) IF( ( NARG .EQ. 12 ) .OR. ( NARG .EQ. 13 ) ) GO TO 100 CALL OTSERR( 80 ) STOP C C - SAVE THE PRESENT PLOTTER STATUS. 100 CSAVE = CSize USAVE = Upsiln IX0S = IX0 IY0S = IY0 C C - CALCULATE THE JUSTIFICATION OF THE TITLE LINES. JUSTFY = 2 IF( NARG .EQ. 12 ) GO TO 200 CALL ITWAS( JUST, 'LCR', 3, JUSTFY ) IF( JUSTFY .EQ. 4 ) JUSTFY = 2 C C - SET NEW ORIGIN AND CHARACTER SIZE. 200 CALL CLRALL CALL CALPLT(X0,Y0,-3) CALL SIZEUP(ABS(SIZE),0.) C C - DRAW THE AXIS AND FILL COMMON /PSTN/. CALL AXES1(X0,Y0,ANGLE,V0,DV,DL,NMAJ,NMIN,NCHRS) IF( SIZE .LE. 0. ) GO TO 300 C C - ANNOTATE THE AXIS. CALL AXES2(V0,DV,NMAJ,NFRAC) C C - LABEL THE AXIS. CALL AXES3(ANGLE,NMAJ,TITLE,NCHRS,SIZE) C C - RETURN TO FORMAT PLOTTER STATUS. 300 CALL SIZEUP(CSAVE,USAVE) CALL CLRALL IX0 = IX0S IY0 = IY0S C RETURN END SUBROUTINE AXES1(X0,Y0,ANGLE,V0,DV,DL,NMAJ,NMIN,NCHRS) C C This subroutine draws the axis and sets the proper C variables in COMMON /PSTN/. C COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax, 1 Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3, 1 CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj COMMON /PSTN/ XZero, XScale, LogX, 1 YZero, YScale, LogY, YMin COMMON /AXESC/ CS, SN, SGN, TX, TY, DX, DY, 1 MIN, MIDL, MAX, MIDU, UMAX, WMAX, IFORM, JUSTFY LOGICAL LogX, LogY C A = 0.01745292519943*ANGLE CS = COS(A) SN = SIN(A) SGN = ISIGN(1,NCHRS) C C - CALCULATE THE SIZES OF THE MAJOR AND MINOR TICK MARKS. TX = DeltaV*SN*SGN TY = -DeltaV*CS*SGN TXM = 0.5*TX TYM = 0.5*TY C - CALCULATE THE MAJOR AND MINOR DIVISION STEP SIZES. DX = DL*CS DY = DL*SN IF( NMIN .LE. 1 ) GO TO 100 DXM = DX/NMIN DYM = DY/NMIN C C - DRAW THE AXIS. 100 XP = 0. YP = 0. CALL CALPLT(TX,TY,2) CALL CALPLT(XP,YP,2) C DO 2000 IMAJ=1,NMAJ C C - DRAW MINOR DIVISIONS AND TICK MARKS IF REQUIRED. IF( NMIN .LE. 1 ) GO TO 1100 DO 1000 IMIN=1,NMIN-1 XP = XP+DXM YP = YP+DYM CALL CALPLT(XP,YP,2) CALL CALPLT(XP+TXM,YP+TYM,2) 1000 CALL CALPLT(XP,YP,2) C C - DRAW TO MAJOR DIVISION AND DRAW MAJOR TICK MARK. 1100 XP = DX*IMAJ YP = DY*IMAJ CALL CALPLT(XP,YP,2) CALL CALPLT(XP+TX,YP+TY,2) 2000 CALL CALPLT(XP,YP,2) C C - X AXIS OR Y AXIS? IF( ABS(SN) .GT. .7 ) GO TO 2100 C C - X AXIS XScale = DX/DV XZero = V0-X0/XScale LOGX = .FALSE. RETURN C C - Y AXIS 2100 YScale = DY/DV YZero = V0-Y0/YScale LOGY = .FALSE. YMin = V0 RETURN C END SUBROUTINE AXES2(V0,DV,NMAJ,NFRAC) C C This subroutine annotates the axis. C COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax, 1 Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3, 1 CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj COMMON /AXESC/ CS, SN, SGN, TX, TY, DX, DY, 1 MIN, MIDL, MAX, MIDU, UMAX, WMAX, IFORM, JUSTFY LOGICAL*1 FRMT(7),VALUE(15) C C C - CALCULATE PRINT FIELD SIZE AND GENERATE FORMAT. NTOTAL = 15 NPRINT = NTOTAL IFRAC = MIN0( MAX0(0,NFRAC), 9 ) IF( IFRAC .EQ. 0 ) NPRINT = NPRINT-1 ENCODE(7,10,FRMT) IFRAC 10 FORMAT( '(F15.',I1,')' ) UMAX = 0. WMAX = 0. ZERO = 10.**( -IFRAC-1 ) C C - ANNOTATE THE AXIS AND FIND THE MINIMUM NUMBER OF LEADING BLANKS. MINB = NPRINT V = V0 XA = 0. YA = 0. DO 2000 IMAJ=1,NMAJ+1 C IF( ABS(V) .LE. ZERO ) GO TO 1200 ENCODE(NTOTAL,FRMT,VALUE) V C C - COUNT THE NUMBER OF LEADING BLANKS. DO 1000 ICHAR=1,NPRINT IF( VALUE(ICHAR) .NE. "40 ) GO TO 1100 1000 CONTINUE 1100 IF( ABS(V) .GE. 1.-ZERO ) GO TO 1400 GO TO 1300 C C - SPECIAL CASE, V = 0. 1200 ICHAR = 14 VALUE(14) = '0' VALUE(15) = '.' GO TO 1400 C C - SPECIAL CASE, ABS(V) .LE. 1. 1300 ICHAR = ICHAR + 1 IF( V .LT. 0. ) VALUE(ICHAR) = '-' C 1400 NWIDTH = NPRINT - ICHAR + 1 C C - MOVE PRINT FIELD SO AS TO CENTER THE ANNOTATION. CALL HCSIZE(VALUE(ICHAR),NWIDTH,W,U,D) WH = W*.5 UH = U*.5 WMAX = AMAX1( WMAX, WH ) UMAX = AMAX1( UMAX, UH ) XP = XA - TX*.375 - ( 1. + SN*SGN )*WH YP = YA - TY*.375 - ( 1. - CS*SGN )*UH CALL HCGEN( XP, YP, 0, 0 ) XA = XA + DX YA = YA + DY 2000 V = V + DV C RETURN END SUBROUTINE AXES3(ANGLE,NMAJ,TITLE,NCHRS,SIZE) C C This subroutine finds the center of the axis an places C the title in the correct spot. C COMMON /PLTR/ ILun, IDev, IsTerm, IMode, IXMax, IYMax, 1 Cnvrsn, CMag, CnvMag, IX0, IY0, KSetNo, IFancy, IBfDv3, 1 CSize, DeltaH, DeltaV, Upsiln, CosUp, SinUp, WidAdj COMMON /AXESC/ CS, SN, SGN, TX, TY, DX, DY, 1 MIN, MIDL, MAX, MIDU, UMAX, WMAX, IFORM, JUSTFY LOGICAL*1 JUSTS(3) DATA JUSTS/'L', 'C', 'R'/ C C - SET TO TITLE CHARACTER SIZE AND CALCULATE TITLE HALF-WIDTH. CALL SIZEUP(1.5*SIZE,ANGLE) ICHRS=IABS(NCHRS) CALL HCSIZE( TITLE, ICHRS, W, U, D ) WH = W/2. UH = U/2. DH = D/2. UDH = UH - DH C C - LOCATE CENTER OF AXIS. XP = 0.5*NMAJ*DX YP = 0.5*NMAJ*DY C C - ALLOW SPACE FOR ANNOTATION. XP = XP - TX*.75 - 2.*SN*SGN*WMAX YP = YP - TY*.75 + 2.*CS*SGN*UMAX C C - WHAT TYPE OF DEVICE? IF( KSetNo ) 200, 100, 300 100 GO TO (200,200,300,200) IDev C C - TEKTRONIX 4010, 4014 AND 4025. 200 XP = XP - ( 1. + SN*SGN )*WH YP = YP - ( 1. - CS*SGN )*UH - ( 1. + CS*SGN )*DH GO TO 400 C C - TEKTRONIX 4662 OR CHARACTER SET GENERATOR. 300 AV = .5*SGN*( ( 1. - SGN )*U - ( 1. + SGN )*D ) XP = XP - CS*WH - SN*AV YP = YP - SN*WH + CS*AV C C - WRITE OUT TITLE. 400 XP = XP + ( JUSTFY-1 )*WH*CosUp YP = YP + ( JUSTFY-1 )*WH*SinUp CALL HCGEN(XP,YP,TITLE,0, JUSTS( JUSTFY ) ) C RETURN END