Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/logaxs.for
There is 1 other file named logaxs.for in the archive. Click here to see a list.
      SUBROUTINE LOGAXS (XO,YO,NCHAR,TITLE,ANGLE,AXSLEN,NCYCLE,IEXP,
     * LABTIC)
C
C
C    THIS ROUTINE IS USED TO DRAW A LOGARITHMIC AXIS
C
C
C    CALLING SEQUENCE:
C
C          CALL LOGAX (XO,YO,NCHAR,TITLE,ANGLE,AXSLEN,NCYCLE,IEXP)
C
C    (XO,YO) - (I) THE STARTING POINT OF THE AXIS
C
C    NCHAR   - (I) THE NUMBER OF CHARACTERS IN THE TITLE (IF NEGATIVE
C                PUT THE TITLE ON THE CLOCKWISE SIDE OF THE AXIS, IF
C                POSITIVE PUT THE TITLE ON THE COUNTER-CLOCKWISE SIDE
C                OF THE AXIS, OR IF ZERO DON'T PUT THE TITLE ON, BUT
C                PUT THE NUMBERING ON THE COUNTER-CLOCKWISE SIDE)
C
C    TITLE   - (I) THE TITLE TO PUT ON THE AXIS
C
C    ANGLE   - (I) THE ANGLE (IN DEGREES) OF THE AXIS
C
C    NCYCLE  - (I) THE NUMBER OF LOGARITHMIC CYCLES WANTED
C
C    IEXP    - (I) THE EXPONENT VALUE OF THE INITIAL VALUE
C
C
C    CALLING SEQUENCE:
C
C    CALL LOGAXS (XO,YO,NCHAR,TITLE,ANGLE,AXSLEN,NCYCLE,IEXP,LABTIC)
C
C    XO, YO, NCHAR, TITLE, ANGLE, AXSLEN, NCYCLE AND IEXP ARE THE SAME
C      AS IN LOGAX
C
C    LABTIC  - (I) THE DELTA FOR LABELING THE TIC MARKS (IF LABTIC IS
C                LESS THAN ONE NO LABELING WILL BE DONE)
C
C
C    SUBPROGRAMS CALLED:
C
C      SIGN, IABS, FLOAT, SYMBOL, NUMBER, COSD, SIND AND PLOT
C
C
      REAL TITLE(1),LOG(9)
      LOGICAL NUMFLG
      EQUIVALENCE (XNUM,XNUM0),(IDIG,ICHAR)
      DATA LOG / 0.301029999, 0.477121256, 0.602059990,
     *           0.698969990, 0.778151251, 0.845098019,
     *           0.903089985, 0.954242498, 1.000000000 /

      GOTO 10

      ENTRY LOGAX (XO,YO,NCHAR,TITLE,ANGLE,AXSLEN,NCYCLE,IEXP)

      LABTIC = 1

10    SIDE = SIGN(0.07,FLOAT(NCHAR))
      X = XO
      Y = YO
      SINE = SIND(ANGLE)
      COSINE = COSD(ANGLE)
      CYCLEN = AXSLEN / FLOAT(NCYCLE)
      XTIC = CYCLEN * COSINE
      YTIC = CYCLEN * SINE

      NUMFLG = LABTIC .LE. 0
      IF (NUMFLG) GOTO 20
      YNUM = -0.2
      IF (SIDE .GE. 0.0) YNUM = 0.1
      IEXP0 = IEXP

20    NCYCL2 = NCYCLE / 2

      DO 70 J = 0,NCYCLE

         IF (J .NE. NCYCL2 .OR. NCHAR .EQ. 0) GOTO 30
         ICHAR = IABS(NCHAR)
         XNUM0 = (AXSLEN - FLOAT(ICHAR) * 0.15) / 2.0
         YNUM0 = -0.40
         IF (SIDE .GE. 0.0) YNUM0 = 0.25
         XN = XO - YNUM0 * SINE + XNUM0 * COSINE
         YN = YO + XNUM0 * SINE + YNUM0 * COSINE
         CALL SYMBOL (XN,YN,0.15,TITLE,ANGLE,ICHAR)

30       IF (NUMFLG) GOTO 50
         IF (J .NE. J / LABTIC * LABTIC) GOTO 40
         IDIG = 2
         IF (IEXP0 .EQ. 0) IDIG = IDIG - 1
         XNUM = -FLOAT(IDIG) * 0.05
         XN = X - YNUM * SINE + XNUM * COSINE
         YN = Y + XNUM * SINE + YNUM * COSINE
         CALL SYMBOL (XN,YN,0.1,'10',ANGLE,IDIG)
	 IF ((IEXP0 .AND. "777777777776) .EQ. 0) GOTO 40
         XNUM = XNUM + FLOAT(IDIG) * 0.1
         YNUM0 = YNUM + 0.075
         XN = X - YNUM0 * SINE + XNUM * COSINE
         YN = Y + XNUM * SINE + YNUM0 * COSINE
         CALL NUMBER (XN,YN,0.05,FLOAT(IEXP0),ANGLE,-1,10)
40       IEXP0 = IEXP0 + 1

50       XM = X
         YM = Y
         SID = SIDE
         DO 60 I = 1,9
            XN = XM - SID * SINE
            YN = YM + SID * COSINE
            CALL PLOT (XN,YN,3)
            CALL PLOT (XM,YM,2)
            IF (J .EQ. NCYCLE) RETURN
            IF (I .EQ. 1) SID = SID * 0.5
            XM = X + XTIC * LOG(I)
            YM = Y + YTIC * LOG(I)
60          CALL PLOT (XM,YM,2)
         X = XM
70       Y = YM

      END