File: AXIS.LS of Disk: V50/Source/Source-Listing-RALF-1
(Source file text)
FORTRAN IV 5AAAA (A6) 8-APR-92 PAGE ONE
0002 SUBROUTINE AXIS(XAX,YAX,TITLE,NCHR,AXLEN,ANG,FV,DV)
C VERSION 50A 30-MAY-80 WVDM
0003 INTEGER PWR
0004 DIMENSION ARRAY(3)
0005 DATA PFCT/'.10'/
0006 ICW=-1
0007 IF(NCHR.GE.0)ICW=1
0010 ZANG=ANG
0011 4 IF(ZANG.LT.0.)ZANG=ZANG+360.
0012 IF(ZANG.GT.360.)ZANG=ZANG-360.
0013 IF(ZANG.GT.360.).OR.(ZANG.LT.0.)GO TO 4
0014 CALL XYPLOT(XAX,YAX,-3)
C MOVE TO START OF AXIS
0015 XPT=ZANG*.017453294
0016 CANGL=COS(XPT)
0017 SANGL=SIN(XPT)
0020 AFV=.1*SANGL*ICW
0021 ADV=.1*CANGL*ICW
0022 XPT=0
0023 YPT=0
0024 IXLEN=ABS(AXLEN)
0025 DO 10 ICHAR=0,IXLEN
0026 CALL XYPLOT(XPT,YPT,2)
0027 XTIC=XPT-AFV
0030 YTIC=YPT+ADV
C DRAW THE TIC MARKS
0031 CALL XYPLOT(XTIC,YTIC,2)
0032 CALL XYPLOT(XPT,YPT,3)
0033 XPT=CANGL*(ICHAR+1)
0034 YPT=SANGL*(ICHAR+1)
0035 10 CONTINUE
0036 IEXP=1
0037 PWR=1
0040 AFV=ABS(FV)
0041 IF(AFV.EQ.0)AFV=ABS(DV)
0042 IF(AFV.GE.100) GO TO 30
0043 IF(AFV.LT.0.01) GO TO 40
C IEXP=EXPONENT, PWR=POWER IN 10S
0044 20 YTIC=(FV+(DV*IXLEN))/PWR
0045 XPT=CANGL*IXLEN-(.2*ICW-.05)*SANGL-.0857*CANGL
0046 YPT=SANGL*IXLEN+(.2*ICW-.05)*CANGL-.0857*SANGL
0047 DO 50 ICHAR=0,IXLEN
0050 CALL NUMBER(XPT,YPT,.14,YTIC,ZANG,2)
C LABEL THE TIC MARK
0051 XPT=XPT-CANGL
0052 YPT=YPT-SANGL
0053 YTIC=YTIC-DV/PWR
0054 50 CONTINUE
0055 PWR=0
0056 55 IF(IEXP/(10**PWR).LT.10)GO TO 60
0057 PWR=PWR+1
0060 GO TO 55
0061 60 ICHAR=IABS(NCHR)
0062 IF(IEXP.GT.1) PWR=PWR+4
C FOR THE 10* CHARACTERS, PWR= # OF DIGITS
FORTRAN IV 5AAAA (A6) 8-APR-92 PAGE TWO
0063 ADV=(IXLEN-(ICHAR+PWR)*.14)/2
0064 XTIC=ADV*CANGL-ICW*.6*SANGL
0065 YPT=ADV*SANGL+ICW*.6*CANGL
0066 CALL SYMBOL(XTIC,YPT,.14,TITLE,ZANG,ICHAR)
C PRINT THE TITLE
0067 IF(IEXP.LE.1)GO TO 70
0070 CALL WHERE(XTIC,YTIC,XPT)
0071 CALL SYMBOL(XTIC,YTIC,.14,PFCT,ZANG,3)
0072 IF (AFV.LT..01) IEXP=-IEXP+2
0073 CALL WHERE(XTIC,YTIC,XPT)
0074 CALL NUMBER(XTIC-.09*SANGL,YTIC+.09*CANGL,.14,IEXP-1,ZANG,-1)
C PRINT THE EXPONENT
0075 70 RETURN
0076 30 XTIC=AFV/PWR
0077 IF(XTIC.LT.100.) GOTO 20
0100 PWR=AINT(PWR*10)
0101 IEXP=IEXP+1
0102 GOTO 30
0103 40 XTIC=AFV*PWR
0104 IF(XTIC.GE.0.01) GOTO 45
0105 PWR=PWR*10
0106 IEXP=IEXP+1
0107 GOTO 40
0110 45 PWR=1/PWR
C FOR THE DIVISION ABOVE
0111 GO TO 20
0112 END