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