FTN,L,C 
C 
C 
C*************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C*************************************************************
C 
C     LISTING:   A92409-80003-1 
C     SOURCE:    92409-80003
C     REV. 1622  C. HAMILTON (3-13-75)
C 
C 
C  AXIS 
C        VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN
      SUBROUTINE AXIS(X,Y,IBCD,SIZE,THETA,XMIN,DX)
      DIMENSION IBCD(2) 
      DIMENSION IXX(3)
      IBCD1=IAND(IBCD(1),377B)
      IXX(1) =3 
      IXX(2) = 25061B 
      IXX(3) = 30000B 
      KN=SIZE 
      A=1.0 
C     SET FOR ANNOTATION ON CLOCKWISE OR COUNTERCLOCKWISE SIDE OF AXIS
      IF (KN) 6,7,7 
    6 A=-A
      KN=-KN
    7 EX=0.0
C     ADJUST DX INTO RANGE OF 1000.0 TO 0.001 
      ADX= ABS  (DX)
      IF (ADX) 1,5,1
    1 IF (ADX-1000.0) 4,2,2 
    2 ADX=ADX/10.0
      EX=EX+1.0 
      GO TO 1 
    3 ADX=ADX*10.0
      EX=EX-1.0 
    4 IF (ADX-0.001) 3,5,5
    5 XVAL=XMIN*10.0**(-EX) 
      ADX= DX  *10.0**(-EX) 
      STH=THETA*0.0174533 
      CTH=COS(STH)
      STH=SIN(STH)
C     CALCULATE STARTING LOCATION FOR TIC MARK ANNOTATION 
      DXB=-0.15 
      DYB=0.2*A-0.05
      XN=X+DXB*CTH-DYB*STH
      YN=Y+DYB*CTH+DXB*STH
      NTIC=KN+1.0 
      NT=NTIC/2 
C  PLOT TIC MARK ANNOTATION INCREMENT 
      DO  20  I=1,NTIC
      ADJ=0.0 
C  DECREMENT ANNOTATION START FOR CHARS. LEFT OF DECIMAL. 
      IF(XVAL) 100,110
  100 ADJ=-0.05 
C  ROUND THE ABSOLUTE VALUE OF THE NUMBER.
  110 RNDN=ABS(XVAL)+.005 
C  DETERMINE NUMBER OF DIGITS TO LEFT OF DECIMAL POINT. 
      LEFT=ALOG(RNDN)*0.43429448+1.0
C  ADJUST FOR TWO OR MORE DIGITS TO LEFT OF DECIMAL POINT.
      IF(LEFT.LE.1) GO TO 120 
C  CALCULATE STARTING POSITION ADJUSTMENT.
      ADJ=ADJ+(LEFT*(-0.05))
  120 XNPLT=XN+ADJ*CTH
      YNPLT=YN+ADJ*STH
      CALL NUMB(XNPLT,YNPLT,.10,XVAL,THETA,3) 
      XVAL=XVAL+ADX 
      XN=XN+CTH 
      YN=YN+STH 
      IF (NT) 20,11,20
   11 Z=IBCD1 
      IF (EX)  12,13,12 
   12 Z=Z+7.0 
C     CALCULATE STARTING LOCATION FOR AXIS TITLE
   13 DXB=-.07*Z+KN*0.5 
      DYB=0.4*A-0.07
      XT=X+DXB*CTH-DYB*STH
      YT=Y+DYB*CTH+DXB*STH
C     PLOT AXIS TITLE 
      CALL SYMB(XT,YT,0.14,IBCD(1),THETA,1) 
C     TEST FOR EXPONENT AND CALCULATE STARTING LOCATION FOR BASE
      IF (EX)  14,20,14 
   14 Z=IBCD1+2 
      XT=XT+Z*CTH*0.14
      YT=YT+Z*STH*0.14
C     PLOT BASE, CALCULATE STARTING LOCATION FOR EXPONENT AND PLOT IT 
      CALL SYMB(XT,YT,0.14,IXX,THETA,1) 
      XT=XT+(3.0*CTH-0.8*STH)*0.14
      YT=YT+(3.0*STH+0.8*CTH)*0.14
      CALL NUMB(XT,YT,0.10,EX,THETA,-1) 
   20 NT=NT-1 
C     MOVE TO END OF AXIS AND CALCULATE SIZE OF TIC MARKS 
      XE=X+KN*CTH 
      YE=Y+KN*STH 
      CALL PLOT(XE,YE,3)
      DXB=-0.07*A*STH 
      DYB=+0.07*A*CTH 
      A=NTIC-1
C     CALCULATE LOCATION OF LAST TIC MARK 
      XN=X+A*CTH
      YN=Y+A*STH
      DO  30  I=1,NTIC
C     PLOT TIC MARKS STARTING WITH THE LAST ONE 
      CALL PLOT(XN,YN,2)
      CALL PLOT(XN+DXB,YN+DYB,2)
      CALL PLOT(XN,YN,2)
      XN=XN-CTH 
      YN=YN-STH 
C     USE THE FOLLOWING IF -0.0 CAN CAUSE PROBLEMS
C     IF (NTIC-1-I) 30,28,20
C  28 XN=X
C     YN=Y
   30 CONTINUE
      RETURN
      END 
C  LINES
C        VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN
      SUBROUTINE LINES(X,Y,N,K,J,C) 
      DIMENSION X(1),Y(1) 
      LMIN = N*K+1
      LDX  = LMIN+K 
      NL   = LMIN-K 
      XMIN = X(LMIN)
      DX   = X(LDX) 
      YMIN = Y(LMIN)
      DY   = Y(LDX) 
C     FIND END OF LINE CLOSEST TO CURRENT PEN POSITION
      CALL WHERE (XN,YN)
      DF = ABS ((X(1)-XMIN)/DX-XN)
      DF2 = ABS ((Y(1)-YMIN)/DY-YN) 
      DL = ABS ((X(NL)-XMIN)/DX-XN) 
      DL2 = ABS ((Y(NL)-YMIN)/DY-YN)
      IF ( DF - DF2 ) 100,101 
C 
  100 DF = DF2
  101 IF (DL - DL2) 102,103 
  102 DL = DL2
  103 IC = 3
      IS = -1 
      NT =IABS(J) 
      IF (J) 2,1,2
    1 NT = 1
    2 IF (DF-DL) 4,4,3
    3 NF = NL 
      NA = ((N-1)/NT)*NT+NT-(N-1) 
      KK = -K 
      GO TO 5 
    4 NF = 1
      NA = NT 
      KK = K
    5 IF (J) 6,7,8
    6 ICA = 3 
      ISA = -1
      LSW = 1 
      GO TO 10
    7 NA = LDX
    8 ICA = 2 
      ISA = -2
      LSW = 0 
   10 DO 30 I = 1,N 
      XN = (X(NF)-XMIN)/DX
      YN = (Y(NF)-YMIN)/DY
C     TEST FOR -0 VALUES OF X AND Y 
C     IF (XN) 14,12,14
C  12 XN = 0.0
C  14 IF (YN) 18,16,18
C  16 YN = 0.0
   18 IF (NA-NT) 20,21,22 
   20 IF (LSW) 23,22,23 
   21 CALL SYMB(XN,YN,0.07,C,0.0,IS)
      NA = 1
      GO TO 25
   22 CALL PLOT (XN,YN,IC)
   23 NA = NA + 1 
   25 NF = NF+KK
      IS = ISA
   30 IC = ICA
      RETURN
      END 
C  SCALE
C        VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN
      SUBROUTINE  SCALE   (Y,YL,NP,L) 
      DIMENSION  Y(1),SAVE(7) 
      SAVE(1)=1.0 
      SAVE(2)=2.0 
      SAVE(3)=4.0 
      SAVE(4)=5.0 
      SAVE(5)=8.0 
      SAVE(6)=10.0
      SAVE(7)=20. 
      FAD=0.001 
      K=IABS(L) 
C     GET MAX AND MIN OF ARAY 
      N=NP*K
      Y0=Y(1) 
      YN=Y0 
      DO  25  I=1,N,K 
      YS=Y(I) 
      IF  (Y0-YS)  22,22,21 
   21 Y0=YS 
      GO TO 25
   22 IF  (YS-YN)  25,25,24 
   24 YN=YS 
   25 CONTINUE
C     YS IS EXPERIMENTAL STARTING VALUE, D IS EXPERIMENTAL DELTA
      YS=Y0 
      IF  (Y0)  34,35,35
   34 FAD=FAD-1.0 
   35 D=(YN-YS)/YL
      IF  (D )  70,70,36
C     P IS POWER OF DELTA 
   36 I=ALOG(D)*0.43429448
      P=10.0**I 
      D=D/P-0.001 
      DO  45  I=1,6 
      IS=I
      IF  (SAVE(I)-D)  45,50,50 
   45 CONTINUE
   50 D=SAVE(IS)*P
C     GET NICE STARTING VALUE 
      YS=IFIX(Y0/D+FAD) 
      YS=D*YS 
      T=YS+(YL+0.001)*D 
      IF  (T-YN)  55,57,57
   55 IS=IS+1 
      GO TO 50
C     CENTER DATA 
   57 YK=IFIX((YL+(YS-YN)/D)/2.0) 
      YS=YS-YK*D
      IF  (Y0*YS)  58,58,59 
   58 YS=0.0
   59 IF  (L)  61,61,65 
C     BACKWARD
   61 YS=YS+YL*D
      D=-D
   65 N=N+1 
      Y(N)=YS 
      N=N+K 
      Y(N)=D
      RETURN
C     IF D IS ZERO
   70 D=1.0 
      YS=YS-0.5 
      GO TO 65
      END 
C  NUMBER 
C        VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN
      SUBROUTINE NUMB (XP, YP, HGT, FPN, THETA, ND) 
C     THIS VERSION OF NUMBER REQUIRES THE SYMBOL VERSION WITH 999.0 
C     X, Y FEATURE, AND NC = 0 FEATURE
      DIMENSION IC (2)
      DIMENSION K1(2) 
      DIMENSION ID (2)
      DIMENSION IE(2) 
      IC(1)=1 
      IC(2)=26400B
      ID(1)=1 
      ID(2)=30000B
      IE(1)=1 
      IE(2)=27000B
      K1(1)=1 
      X = XP
      Y = YP
      H = HGT 
      FPV = FPN 
      TH = THETA
      N = ND
      MAXN=7
      SAMEV = 9999.0
C     SET N VALUE TO + OR - MAXN, IF OUT OF RANGE 
      IF (N - MAXN) 11, 11, 10
   10 N = MAXN
   11 IF (N + MAXN) 12, 20, 20
   12 N = -MAXN 
C     INSERT MINUS SIGN IN FRONT OF NUMBER, IF NEGATIVE 
   20 IF (FPV) 21, 30, 30 
   21 CALL SYMB (X,Y,H,IC(1),TH,1)
C     WHEN SYMBOL IS CALLED WITH SAMEV FOR X AND Y, THE CHARACTER STRING
C     CONTINUES FROM THE LAST CHARACTER PLOTTED BY SYMBOL 
      X = SAMEV 
      Y = SAMEV 
C     MN LOCATES EXPONENT VALUE FOR PROPER ROUNDING OF NUMBER 
   30 MN = -N 
C     IF SCALING IS DONE, MN MUST BE ADJUSTED 
      IF (N) 31, 32, 32 
   31 MN = MN - 1 
C     ROUND INPUT NUMBER AND SET TO POSITIVE VALUE
   32 FPV = ABS(FPV) + (0.5 * 10. ** MN)
C     DETERMINE CHARACTERISTIC OF FPV AND INCREMENT IT BY 1 
      I = ALOG (FPV) * 0.43429448 + 1.0 
      ILP = I 
C     IF SCALING IS DONE, ILP MUST BE REDUCED ACCORDING TO SCALING
      IF (N + 1)  40, 41, 41
   40 ILP = ILP + N + 1 
C     IF NUMBER IS LESS THAN 1 PLOT A ZERO BEFORE DECIMAL (IF ANY)
   41 IF (ILP) 50, 50, 51 
   50 CALL SYMB (X,Y,H,ID(1),TH,1)
      X = SAMEV 
      Y = SAMEV 
      GO TO 61
C     ILP IS NUMBER OF DIGITS TO LEFT OF DECIMAL POINT
   51 DO 60 J = 1, ILP
C     LOCATE SINGLE LEFTMOST DIGIT OF NUMBER
      K = FPV * 10. ** (J - I)
      K1(2)=(K+48)*256
      CALL SYMB(X,Y,H,K1(1),TH,0) 
C     SUBTRACT VALUE OF PREVIOUS DIGIT FROM NUMBER TO LOCATE NEXT DIGIT 
      FPV = FPV - (FLOAT(K) * 10. ** (I - J)) 
      X = SAMEV 
   60 Y = SAMEV 
C     NO DECIMAL POINT IS PLOTTED IF N IS NEGATIVE, EXIT FROM ROUTINE 
   61 IF (N) 99, 70, 70 
   70 CALL SYMB (X,Y,H,IE(1),TH,1)
C     PLOT DIGITS TO RIGHT OF DECIMAL IF N GT 0, OTHERWISE EXIT 
      IF (N)  99, 99, 80
   80 DO 90 J = 1, N
C     SCALE FRACTIONAL REMAINDER TO GIVE INTEGER DIGIT
      K = FPV * 10. 
      K1(2)=(K+48)*256
      CALL SYMB(X,Y,H,K1(1),TH,0) 
C     SUBTRACT INTEGER VALUE TO LOCATE NEXT DIGIT 
   90 FPV = FPV * 10. - FLOAT(K)
   99 RETURN
      END 
      END$