Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00100 SUBROUTINE XYAXIS(IX,IY,PX,PY,N,XTITLE,YTITLE,MAXL,MAYL,SX,SY,
00200 . ZX,ZY)
00300 C
00400 C TITLE - XYAXIS
00500 C AUTHOR - MARGIE ODLE, SSCC, JANUARY 1972
00600 C
00700 C PURPOSE - TO PLOT X AXIS AND/OR Y AXIS GUARANTEEING
00800 C 1) ZERO INCLUDED IN LABELS
00900 C 2) AXIS LENGTH
01000 C 3) ''NICE'' INTERVALS ALONG THE AXES
01100 C
01200 C INPUT
01300 C BY ARGUMENT LIST
01400 C PX - POINTS TO PLOT IN X DIRECTION
01500 C PY - POINTS TO PLOT IN Y DIRECTION
01600 C N - NUMBER OF PX,PY PAIRS
01700 C XTITLE - TITLE ALONG X AXIS
01800 C YTITLE - TITLE ALONG Y AXIS
01900 C MAXL - MAX LENGTH X AXIS
02000 C MAYL - MAX LENGTH Y AXIS
02100 C SX - X COORD. IN INCHES OF BOTTOM OF PLOT
02200 C SY - Y COORD. IN INCHES OF BOTTOM OF PLOT
02300 C COMMON/GRID/
02400 C XGR - >0 MEANS DRAW X GRID LINES. IF NO X AXIS IS
02500 C DRAWN, XGR IS LENGTH OF GRID LINES
02600 C YGR - >0 MEANS DRAW Y GRID LINES. IF NO Y AXIS, INDICATES
02700 C LENGTH OF THESE GRID LINES.
02800 C
02900 C
03000 C OUTPUT
03100 C COMMON/XOUT/
03200 C XZ - X COORD IN INCHES OF ZERO LABEL OF X AXIS
03300 C XQ - X COORD IN INCHES OF END OF X AXIS
03400 C PXP - ADJUSTED X DIRECTION POINTS FOR PLOTTING
03500 C
03600 C COMMON/YOUT/
03700 C YZ - Y COORD IN INCHES OF ZERO LABEL OF Y AXIS
03800 C YQ - Y COORD IN INCHES OF TOP OF Y AXIS
03900 C PYP - ADJUSTED Y DIRECTION POINTS FOR PLOTTING
04000 C
04100 C CALLS - AXXIS
04200 C
04300 COMMON/SWITCH/ IST,RIGHT
04400 COMMON/GRID/XGR,YGR
04500 COMMON/XOUT/XZ,XQ,PXP
04600 COMMON/YOUT/ YZ,YQ,PYP
04700 DIMENSION PX(N),PY(N),XTITLE(12),YTITLE(12)
04800 DIMENSION PXP(1),PYP(1)
04900 IST=1
05000 IF (IX .GT. 0) IST=3
05100 J=IST
05200 XQ=0.
05300 XZ=0.
05400 YQ=0.
05500 YZ=0.
05600 CALL AXXIS(J,PX,N,XTITLE,MAXL,SX,SY,ZX)
05700 J=2
05800 IF (IY .GT. 0) J=4
05900 CALL AXXIS(J,PY,N,YTITLE,MAYL,SX,SY,ZY)
06000 RETURN
06100 END
06200 C
06300 C********************************************************
06400 C
06500 SUBROUTINE XAXIS(IX,PX,N,XTITLE,MAXL,SX,SY,ZX)
06600 C
06700 C SPECIFICATIONS FOR INPUT SAME AS ABOVE.
06800 C THE ONLY ONES THAT APPLY ARE FOR THE X AXIS
06900 C
07000 DIMENSION PX(N),XTITLE(12)
07100 DIMENSION PXP(1)
07200 COMMON/XOUT/ XZ,XQ,PXP
07300 COMMON/SWITCH/ IST,RIGHT
07400 COMMON/GRID/XGR,YGR
07500 IST=0
07600 XZ=0.
07700 XQ=0.
07800 J=1
07900 IF (IX .GT. 0) J=3
08000 CALL AXXIS(J,PX,N,XTITLE,MAXL,SX,SY,ZX)
08100 RETURN
08200 END
08300 C
08400 C**************************************************************
08500 C
08600 SUBROUTINE Y2AXIS(IY,PY,N,YTITLE,MAYL,R,SY,ZY)
08700 DIMENSION PY(N),PYP(1),YTITLE(12),PXP(1)
08800 COMMON/SWITCH/ IST,RIGHT
08900 COMMON/YOUT/YZ,YQ,PYP
09000 COMMON/XOUT/XZ,XQ,PXP
09100 COMMON/GRID/XGR,YGR
09200 LOGICAL RIGHT
09300 RIGHT=.TRUE.
09400 IF (R .GE. 0) SX=R-.75
09500 IF (R .LT. 0) SX=XQ-.75-.1
09600 CALL YAXIS(IY,PY,N,YTITLE,MAYL,SX,SY,ZY)
09700 RIGHT=.FALSE.
09800 RETURN
09900 END
10000 C
10100 C********************************************************
10200 C
10300 SUBROUTINE YAXIS(IY,PY,N,YTITLE,MAYL,SX,SY,ZY)
10400 C
10500 C SPECIFICATIONS FOR INPUT SAME AS ABOVE
10600 C THE ONLY ONES THAT APPLY ARE FOR THE Y AXIS
10700 C
10800 DIMENSION PY(N),YTITLE(12)
10900 DIMENSION PYP(1)
11000 COMMON/YOUT/YZ,YQ,PYP
11100 COMMON/SWITCH/ IST,RIGHT
11200 COMMON/GRID/XGR,YGR
11300 IST=0
11400 IF (.NOT. RIGHT)YZ=0.
11500 YQ=0.
11600 J=2
11700 IF (IY .GT. 0) J=4
11800 CALL AXXIS(J,PY,N,YTITLE,MAYL,SX,SY,ZY)
11900 RETURN
12000 END
12100 C
12200 C********************************************************
12300 C
12400 SUBROUTINE AXXIS(K,S,N,TITLE,MAXL,SX,SY,ZZ)
12500 C
12600 C TITLE - AXXIS
12700 C PURPOSE - TO DRAW AN AXIS WITH ''NICE'' LABELS.
12800 C AUTHOR - MARGIE ODLE, SSCC, JANUARY 1972
12900 C
13000 C THIS SUBROUTINE IS CALLED FROM XYAXIS.
13100 C
13200 DIMENSION S(N),TITLE(12),TTITLE(12)
13300 COMMON /XOUT/ XZ,XQ,PXP
13400 COMMON/YOUT/ YZ,YQ,PYP
13500 COMMON/GRID/XGR,YGR
13600 COMMON /SWITCH/ IST,RIGHT
13700 LOGICAL RIGHT
13800 COMMON/XYSPEC/ XINTIN,YINTIN,XAX,YAX,XINT,YINT,NXINT,
13900 . NYINT,XLAB,YLAB,IZX,IZY,ILAG(2),ILAGG(2),IQ,IQQ
14000 REAL MAXL,MAX,MIN
14100 INTEGER SSS,SSS1
14200 DIMENSION PYP(1),PXP(1)
14300 DIMENSION AS(8),XINTED(8,3)
14400 DATA XINTED/3.,5.,7.,9.,4*0,3.,5.,6.,7.,8.,9.,2*0.,2.,3.,4.,
14500 . 5.,6.,7.,8.,9./
14600 XC=SX+.75
14700 YC=SY+.75
14800 C
14900 C FIND MIN AND MAX
15000 C
15100 MIN=S(1)
15200 MAX=MIN
15300 DO 10 I=2,N
15400 IF (MIN .GT. S(I)) MIN=S(I)
15500 IF (MAX .LT. S(I)) MAX=S(I)
15600 10 CONTINUE
15700 C
15800 C SET UP AXIS
15900 C
16000 GO TO (1000,2000,3000,4000),K
16100 1000 CALL DOAXIS(MIN,MAX,MAXL,1,NDIG,ZZ)
16200 DO 13 I=1,12
16300 13 TTITLE(I)=TITLE(I)
16400 XQ=XC+XAX+.1
16500 IF (IST .NE. 1) GO TO 12
16600 IQ1=IQ
16700 IQQ1=IQQ
16800 NNDIG=NDIG
16900 GO TO 30
17000 C
17100 C DO PLOTTING OF AXIS
17200 C
17300 12 YZ=YC
17400 15 CALL PLOT(XC-.1,YZ,3)
17500 CALL PLOT(XQ,YZ,2)
17600 CALL PLOT(XQ,YZ+.001,3)
17700 CALL PLOT(XC-.1,YZ+.001,2)
17800 CALL PLOT(XC-.1,YZ-.001,3)
17900 CALL PLOT(XQ,YZ-.001,2)
18000 IF (IST .LE. 1) GO TO 18
18100 IQ=IQ1
18200 IQQ=IQQ1
18300 NDIG=NNDIG
18400 C
18500 C PUT TICK MARKS AND LABELS
18600 C
18700 18 XV=XQ-.1
18800 XVV=XLAB
18900 DO 25 I=1,NXINT+1
19000 CALL PLOT(XV,YZ-.06,3)
19100 CALL PLOT(XV,YZ+.06,2)
19200 IF (XGR .LE. 0.) GO TO 19
19300 IF (YQ .LE. 0.) YQ=XGR
19400 CALL PLOT(XV,YC-.1,3)
19500 CALL PLOT(XV,YQ,2)
19600 19 CONTINUE
19700 C DO LABELS
19800 CALL NUMBER(XV-.04*(3+IQQ-IQ),YZ-.2,.08,XVV,0.,NDIG)
19900 IF ( I .EQ. NXINT+1) GO TO 25
20000 DO 21 J=1,3
20100 XJ=.04-MOD(J,2)/100.
20200 XO=XINTIN/4.*FLOAT(J)
20300 CALL PLOT(XV-XO,YZ-XJ,3)
20400 CALL PLOT(XV-XO,YZ+XJ,2)
20500 21 CONTINUE
20600 XVV=XVV-XINT*10.**(IQQ-IQ)
20700
20800 XV=XV-XINTIN
20900 25 CONTINUE
21000 C
21100 C PLOT EXPONENT OF LABELS
21200 C
21300 CALL SYMBOL(XQ+.3,YZ-.2,.08,ILAG,0.,10)
21400 C
21500 C PLOT TITLE
21600 C
21700 CALL PLACET(TTITLE,BX,SIZE,NCHARS,IBL,.09,XQ,XC)
21800 IF (NCHARS .LE. 0) GO TO 27
21900 CALL SYMBOL(BX,YC-.5,SIZE,TTITLE(IBL),0.,NCHARS)
22000 27 IF (IST .GT. 1) GO TO 90
22100 30 XZ=XC+(IZX-1.)*XINTIN
22200 C
22300 C ADJUST THE XPOINTS RELATIVE TO NEW ZERO
22400 C
22500 XPL=ABS(XLAB)*10.**IQ
22600 XVV=XLAB-NXINT*XINT*10.**(IQQ-IQ)
22700 XNL=(XVV)*10.**IQ
22800 DO 40 I=1,N
22900 SA=(S(I)-XNL)*XAX/(XPL-XNL)
23000 PXP(I)=SA+XC
23100 40 CONTINUE
23200 RETURN
23300 C
23400 C THIS PART DOES THE YAXIS
23500 C
23600 2000 CONTINUE
23700 IF (YC+MAXL .GT. 10.5) GO TO 5000
23800 CALL DOAXIS(MIN,MAX,MAXL,2,NDIG,ZZ)
23900 C
24000 C MAY BE DOING BOTH AXES
24100 C
24200 C PLOT Y AXIS
24300 C
24400 IF (XZ .LT. XC) XZ=XC
24500 YCS=0.
24600 IF (.NOT. RIGHT) GO TO 74
24700 YZZ=YC+(IZY-1)*YINTIN
24800 DEL=YZZ-YZ
24900 IF (DEL)2060,74,2060
25000 2060 YCC=YC-DEL
25100 IF (ABS(YCC-YC) .GT. .5) GO TO 5003
25200 YCS=YC
25300 YC=YCC
25400 74 CONTINUE
25500 YQ=YC+YAX+.1
25600 CALL PLOT(XZ,YC-.1,3)
25700 CALL PLOT(XZ,YQ,2)
25800 CALL PLOT(XZ-.001,YQ,3)
25900 CALL PLOT(XZ-.001,YC-.1,2)
26000 CALL PLOT(XZ+.001,YC-.1,3)
26100 CALL PLOT(XZ+.001,YQ,2)
26200 C
26300 C PUT TICK MARKS
26400 C
26500 YVV=YLAB
26600 YV=YQ-.1
26700 DO 80 I=1,NYINT+1
26800 CALL PLOT(XZ-.06,YV,3)
26900 CALL PLOT(XZ+.06,YV,2)
27000 IF (YGR .LE. 0.) GO TO 73
27100 IF (XQ .LE. 0.) XQ=YGR
27200 CALL PLOT(XC-.1,YV,3)
27300 CALL PLOT(XQ,YV,2)
27400 73 CONTINUE
27500 C
27600 C PRINT LABELS
27700 C
27800 SIGN=-1.
27900 IF (RIGHT) SIGN=.25
28000 CALL NUMBER(XZ+SIGN*(.2+.08*(3+IQQ-IQ)),YV-.04,.08,YVV,
28100 . 0.,NDIG)
28200 IF (I .EQ. NYINT+1) GO TO 80
28300 DO 75 J=1,3
28400 XJ=.04-MOD(J,2)/100.
28500 YO=YINTIN/4.*FLOAT(J)
28600 CALL PLOT(XZ-XJ,YV-YO,3)
28700 CALL PLOT(XZ+XJ,YV-YO,2)
28800 75 CONTINUE
28900 YV=YV-YINTIN
29000 YVV=YVV-YINT*10.**(IQQ-IQ)
29100 80 CONTINUE
29200 C
29300 C PLOT EXPONENT OF LABELS
29400 CALL SYMBOL(XZ-.4,YQ+.1,.08,ILAGG,0.,10)
29500 C
29600 C PLOT THE TITLE
29700 C
29800 CALL PLACET(TITLE,BY,SIZE,NCHARS,IBL,.09,YQ,YC)
29900 IF (NCHARS .LE. 0) GO TO 81
30000 XCC=XC+SIGN*.7
30100 IF (RIGHT) XCC=XCC+.55
30200 CALL SYMBOL(XCC,BY,SIZE,TITLE(IBL),90.,NCHARS)
30300 81 YZ=YC+(IZY-1)*YINTIN
30400 C
30500 C PLOT X AXIS AND COME BACK IF NECESSARY
30600 C
30700 C
30800 C ADJUST Y POINTS
30900 C
31000 YPL=ABS(YLAB)*10.**IQ
31100 YVV=YLAB-NYINT*YINT*10.**(IQQ-IQ)
31200 YNL=(YVV)*10.**IQ
31300 DO 100 I=1,N
31400 SA=(S(I)-YNL)*YAX/(YPL-YNL)
31500 PYP(I)=SA+YC
31600 100 CONTINUE
31700 90 CONTINUE
31800 IF (YCS .NE. 0) YC=YCS
31900 IST=IST+1
32000 IF (IST .EQ. 2) GO TO 15
32100 IF (IST .EQ. 4) GO TO 150
32200 IST=0
32300 RETURN
32400 C
32500 C X - AXIS LOG SCALE
32600 C
32700 3000 CONTINUE
32800 CALL DOLOG(MIN,MAX,MAXL,1)
32900 DO 110 I=1,12
33000 110 TTITLE(I)=TITLE(I)
33100 IF (IST .NE. 3) GO TO 112
33200 IQ1=IQ
33300 IQQ1=IQQ
33400 XQ=XC+XAX+.1
33500 GO TO 130
33600 112 YZ=YC
33700 C
33800 C PLOT THE X - AXIS
33900 C
34000 150 CALL PLOT(XC-.1,YZ,3)
34100 CALL PLOT(XQ,YZ,2)
34200 CALL PLOT(XQ,YZ+.001,3)
34300 CALL PLOT(XC-.1,YZ+.001,2)
34400 CALL PLOT(XC-.1,YZ-.001,3)
34500 CALL PLOT(XQ,YZ-.001,2)
34600 IF (IST .LE. 1) GO TO 118
34700 IQ=IQ1
34800 IQQ=IQQ1
34900 118 SS=XC
35000 JX=XLAB
35100 SSS=0
35200 1181 IF (JX .LT. 10) GO TO 1182
35300 JX=JX/10
35400 SSS=SSS+1
35500 GO TO 1181
35600 1182 NDIG=IQQ+1
35700 C
35800 C FIGURE OUT INTERMEDIATE TICK MARKS
35900 C
36000 XKP=XINTIN
36100 INTED=4
36200 IF (XINTIN .GT. 1.) INTED=6
36300 IF (XINTIN .GE. 1.4) INTED=8
36400 JJ=INTED/2-1
36500 DO 119 I=1,INTED
36600 P=XINTED(I,JJ)
36700 119 AS(I)=ALOG10(P)*XKP
36800 C PLOT TICK MARKS
36900 C
37000 DO 125 I=1,NXINT+1
37100 CALL PLOT(SS,YZ-.08,3)
37200 CALL PLOT(SS,YZ+.08,2)
37300 C
37400 C PLOT GRID LINES
37500 C
37600 IF (XGR .LE. 0) GO TO 135
37700 IF (YQ .LE. 0) YQ=XGR
37800 CALL PLOT(SS,YC-.1,3)
37900 CALL PLOT(SS,YQ,2)
38000 135 ENCODE(5,137,SSS1)SSS
38100 137 FORMAT('10^',I1)
38200 CALL SYMBOL(SS-.07,YZ-.21,.07,SSS1,0.,5)
38300 SW=.FALSE.
38400 C
38500 C PLOT INTERMEDIATE TICK MARKS
38600 C
38700 IF (I .EQ. NXINT+1) GO TO 125
38800 DO 120 J=1,INTED
38900 SW=.NOT. SW
39000 CALL PLOT(SS+AS(J),YZ-.04,3)
39100 CALL PLOT(SS+AS(J),YZ+.04,2)
39200 IF (SW) CALL NUMBER(SS+AS(J),YZ-.15,.07,XINTED(J,JJ),
39300 . 0.,-1)
39400 120 CONTINUE
39500 SSS=SSS+1
39600 SS=SS+XINTIN
39700 125 CONTINUE
39800 C
39900 C PLOT EXPONENT OF LABELS
40000 C
40100 CALL SYMBOL(XQ+.3,YZ-.2,.08,ILAG,0.,10)
40200 C
40300 C PLOT TITLE
40400 C
40500 CALL PLACET(TTITLE,BX,XIZE,NCHARS,IBL,.09,XQ,XC)
40600 IF (NCHARS .LE. 0) GO TO 127
40700 CALL SYMBOL(BX,YC-.52,SIZE,TTITLE(IBL),0,NCHARS)
40800 127 IF (IST .GT. 1) GO TO 190
40900 C
41000 C ADJUST THE POINTS
41100 C
41200 130 XZ=XC+(IZX-1)*XINTIN
41300 A=NXINT
41400 XK=XAX/A
41500 DO 155 I=1,N
41600 Q=ALOG10(XLAB)
41700 SSSS=S(I)
41800 IF (S(I) .LE. 0.) SSSS=.1
41900 PXP(I)=(ALOG10(SSSS/10.**IQ)-Q)*XK+XZ
42000 155 CONTINUE
42100 RETURN
42200 C
42300 C Y - AXIS LOG SCALE
42400 C
42500 4000 CONTINUE
42600 IF (YC+MAXL .GT. 10.5) GO TO 5000
42700 CALL DOLOG(MIN,MAX,MAXL,2)
42800 IF (XZ .LT. XC) XZ=XC
42900 C
43000 C PLOT THE Y - AXIS
43100 C
43200 YQ=YC+MAXL+.1
43300 CALL PLOT(XZ,YC-.1,3)
43400 CALL PLOT(XZ,YQ,2)
43500 CALL PLOT(XZ-.001,YQ,3)
43600 CALL PLOT(XZ-.001,YC-.1,2)
43700 CALL PLOT(XZ+.001,YC-.1,3)
43800 CALL PLOT(XZ+.001,YQ,2)
43900 SS=YC
44000 JX=YLAB
44100 SSS=0
44200 1611 IF (JX .LT. 10) GO TO 1612
44300 SSS=SSS+1
44400 JX=JX/10
44500 GO TO 1611
44600 C
44700 C FIGURE OUT INTERMEDIATE TICK MARKS
44800 C
44900 1612 NDIG=IQQ+1
45000 XKP=YINTIN
45100 INTED=4
45200 IF (YINTIN .GT. 1.) INTED=6
45300 IF (YINTIN .GE. 1.4) INTED=8
45400 JJ=INTED/2-1
45500 DO 161 I=1,INTED
45600 P=XINTED(I,JJ)
45700 161 AS(I)=ALOG10(P)*XKP
45800 C
45900 C PLOT TICK MARKS
46000 C
46100 DO 160 I=1,NYINT+1
46200 CALL PLOT(XZ-.07,SS,3)
46300 CALL PLOT(XZ+.07,SS,2)
46400 IF (YGR .LE. 0) GO TO 163
46500 IF (XQ .LE. 0) XQ=YGR
46600 CALL PLOT(XC-.1,SS,3)
46700 CALL PLOT(XQ,SS,2)
46800 163 CONTINUE
46900 SIGN=-1.
47000 IF (RIGHT) SIGN=.25
47100 PD=XC+SIGN*(5*.07-.17)
47200 ENCODE(5,137,SSS1)SSS
47300 CALL SYMBOL(PD,SS,.07,SSS1,0.,5)
47400 IF (I .EQ. NYINT+1) GO TO 160
47500 SW=.FALSE.
47600 C
47700 C PLOT INTERMEDIATE TICK MARKS
47800 C
47900 DO 165 J=1,INTED
48000 SW=.NOT. SW
48100 CALL PLOT(XZ-.04,SS+AS(J),3)
48200 CALL PLOT(XZ+.04,SS+AS(J),2)
48300 IF (SW) CALL NUMBER(XC+SIGN*.17,SS+AS(J),.07,XINTED(J,JJ),
48400 . 0.,-1)
48500 165 CONTINUE
48600 SS=SS+YINTIN
48700 SSS=SSS+1
48800 NDIG=NDIG+1
48900 160 CONTINUE
49000 C
49100 C PLOT EXPONENT OF LABELS
49200 C
49300 CALL SYMBOL(XZ-.4,YQ+.1,.08,ILAGG,0.,10)
49400 C
49500 C PLOT THE TITLE
49600 C
49700 CALL PLACET(TITLE,BY,SIZE,NCHARS,IBL,.09,YQ,YC)
49800 IF (NCHARS .LE. 0) GO TO 1651
49900 XCC=XC+SIGN*.7
50000 IF (RIGHT) XCC=XCC+.55
50100 CALL SYMBOL(XCC,BY,SIZE,TITLE(IBL),90.,NCHARS)
50200 1651 YZ=YC
50300 C
50400 C ADJUST POINTS
50500 C
50600 A=NYINT
50700 XK=MAXL/A
50800 DO 170 I=1,N
50900 Q=ALOG10(YLAB)
51000 SSSS=S(I)
51100 IF (S(I) .LE. 0) SSSS=.1
51200 PYP(I)=(ALOG10(SSSS/10.**IQ)-Q)*XK+YZ
51300 170 CONTINUE
51400 190 CONTINUE
51500 IST=IST+1
51600 IF (IST .EQ. 2) GO TO 15
51700 IF (IST .EQ. 4) GO TO 150
51800 IST=0
51900 RETURN
52000 5000 TYPE 5001
52100 5001 FORMAT(' THE Y AXIS IS TOO LONG, RESPECIFY MAX LENGTH :'$)
52200 ACCEPT 5002,MAXL
52300 5002 FORMAT(F)
52350 KKK=K/2
52400 GO TO (2000,4000),KKK
52500 5003 TYPE 5004
52600 5004 FORMAT(' THE ADJUSTMENT OF RIGHT AXIS IS NOT POSSIBLE '/)
52700 GO TO 90
52800 END
52900 SUBROUTINE DOAXIS(MIN,MAX,MAXL,III,NDIG,ZZ)
53000 C
53100 C*******************************************************************
53200 C
53300 C TITLE - DOAXIS
53400 C AUTHOR - MARGIE ODLE, SSCC, JANUARY 1972
53500 C
53600 C DOAXIS SETS THINGS UP FOR THE SELECTION OF THE AXIS PARAMETERS
53700 C
53800 C INPUT
53900 C MIN - MIN VALUE TO BE PLOTTED
54000 C MAX - MAX VALUE TO BE PLOTTED
54100 C MAXL - MAX LENGTH OF AXIS
54200 C III - 1 IF X-AXIS, 2 IF Y-AXIS
54300 C
54400 REAL MIN,MAX,MAXL
54500 REAL IYYM,IYY
54600 COMMON/XYSPEC/XINTIN(2),XAX(2),XINT(2),NINT(2),XLAB(2),
54700 . IZX(2),ILAG(2,2),IQ,IQQ
54800 DIMENSION ILAB(2,-2/3)
54900 C
55000 C SPECIFY AXIS UNITS LABELS
55100 C
55200 DATA ((ILAB(I,J),I=1,2),J=-2,3)/
55300 . 'MILLI','ONTHS','THOUS','ANDTH',' ',' ',
55400 . 'THOUS','ANDS ','MILLI','ONS ','TRILL','IONS '/
55500 C
55600 C WANT TO FORCE ZERO POINT
55700 C
55800 IF (ZZ .LE. 0.) GO TO 5
55900 IF (MIN .GT. 0.) MIN=0.
56000 IF (MAX .LT. 0.) MAX=0.
56100 5 IYYM=0
56200 IYY=0
56300 QQ=AMAX1(MAX,ABS(MIN))
56400 C
56500 C FIND PROPER UNITS FOR LABELS
56600 C
56700 DO 10 I=9,-6,-3
56800 IF (QQ/10.**I .GE. 1.) GO TO 12
56900 10 CONTINUE
57000 GO TO 5000
57100 12 IQ=I
57200 C
57300 C PICK PROPER AXIS UNITS LABEL
57400 C
57500 ILAG(1,III)=ILAB(1,IQ/3)
57600 ILAG(2,III)=ILAB(2,IQ/3)
57700 C
57800 C DETERMINE IF LABELS THEMSELVES ARE ONES,TENS,OR HUNDREDS
57900 C
58000 I=IQ+2
58100 IF (QQ/10.**I .GE. 1.) GO TO 14
58200 I=I-1
58300 IF (QQ/10.**(I) .GE. 1.) GO TO 14
58400 I=I-1
58500 14 IQQ=I
58600 C
58700 C ONLY USE HIGH ORDER DIGIT
58800 C
58900 IYYM=(MAX/10.**IQQ)
59000 IYY=(MIN/10.**IQQ)
59100 C
59200 C CALL SELECT TO DO AXIS PARAMETERS.
59300 C
59400 CALL SELECT(IYYM,IYY,MAXL,XINT(III),NINT(III),XAX(III),
59500 . XINTIN(III),NDIG)
59600 C TYPE 8002,IYYM,IYY,MAXL,XINT(III),NINT(III),XAX(III),XINTIN(III)
59700 C 8002 FORMAT(' IYYM=',F6.2,' IYY=',F6.2,'MAXL=',F4.1,' XINT=',F4.1,
59800 C . ' NINT=',I4,' XAX=',F4.1,'XINTIN=',F5.3/)
59900 C
60000 C COMPUTE BIGGEST LABEL OF AXIS
60100 C
60200 19 XLAB(III)=IYYM*XINT(III)*10.**IABS(IQQ-IQ)
60300 C
60400 C LOCATE ZERO LABEL
60500 C
60600 IF (IYY .GT. 0) IYY=0
60700 IZX(III)=-IYY+1.1
60800 RETURN
60900 5000 TYPE 5001
61000 5001 FORMAT(' SOMETHING WRONG IN DOAXIS'/)
61100 CALL EXIT
61200 END
61300 C
61400 C*******************************************************************
61500 C
61600 SUBROUTINE SELECT(YYM,YY,MAXL,XINT,NINT,XAX,XINTIN,NDIG)
61700 C
61800 C TITLE - SELECT
61900 C AUTHOR - MARGIE ODLE, SSCC, JANUARY 1972
62000 C
62100 C SELECT SELECTS THE AXIS PARAMETERS FOR PLOTTING
62200 C CALLED FROM DOAXIS
62300 C
62400 C DEFINITION OF PARAMETERS
62500 C
62600 C INPUT
62700 C YYM - LEAD DIGIT OF MAXIMUM POINT TO BE PLOTTED
62800 C YY - LEAD DIGIT OF MINIMUM POINT TO BE PLOTTED
62900 C MAXL - MAX LENGTH OF AXIS
63000 C OUTPUT
63100 C XINT - INTERVAL LENGTH IN UNITS
63200 C NINT - NUMBER OF INTERVALS
63300 C XAX - ACTUAL LENGTH OF AXIS (=MAXL)
63400 C XINTIN - INTERVAL LENGTH IN INCHES
63500 C
63600 C
63700 C XX IS ARRAY OF POSSIBLE INTERVAL VALUES TO BE SELECTED
63800 C
63900 DIMENSION XX(10)
64000 REAL MAXL
64100 DATA (XX(I),I=1,10)/.01,.1,.2,.25,.5,.8,1.,2.,2.5,5./
64200 XAX=MAXL
64300 SS=1.
64400 IF (YYM*YY .GT. 0) SS=-1.
64500 DO 200 I=1,10
64600 C
64700 C COMPUTE NUMBER OF INTERVALS ABOVE AND BELOW ZERO
64800 C
64900 IAQ=YYM/XX(I)
65000 IBQ=ABS(YY/XX(I))
65100 C
65200 C MAKE SURE ENTIRE POSITIVE INTERVAL COVERED
65300 C
65400 5 IF (IAQ*XX(I) .GE. YYM) GO TO 10
65500 IAQ=IAQ+1
65600 GO TO 5
65700 C
65800 C MAKE SURE ENTIRE NEGATIVE INTERVAL COVERED
65900 C
66000 10 IF (IBQ*XX(I) .GE. ABS(YY)) GO TO 20
66100 IBQ=IBQ+1
66200 GO TO 10
66300 20 IF (SS .GT. 0.) GO TO 21
66400 IF (IBQ*XX(I) .NE. ABS(YY)) IBQ=IBQ-1
66500 21 CONTINUE
66600 NINT=IAQ+IBQ*SS
66700 C
66800 C SET INTERVAL LENGTH - UNITS
66900 C
67000 IF (NINT .GT. 20) GO TO 200
67100 C
67200 C COMPUTE INTERVAL LENGTH IN INCHES
67300 C
67400 XINTIN=MAXL/NINT
67500 C
67600 C BOUNDS ARBITRARILY SET AT .5 AND 1.5
67700 C
67800 IF (XINTIN .GE. .5 .AND. XINTIN .LE. 1.5) GO TO 300
67900 200 CONTINUE
68000 C
68100 C SOMETHING IS WRONG
68200 C
68300 TYPE 1,YYM,YY,MAXL,XINTIN
68400 1 FORMAT(' COULD NOT FIT AXIS'/' YYM=',F6.2,' YY=',F6.2,
68500 . ' MAXL=',F7.1,' XINTIN=',F6.1/)
68600 CALL EXIT
68700 300 CONTINUE
68800 C TYPE 2,YYM,YY,IAQ,IBQ,XINTIN,XX(I),NINT,MAXL,XAX
68900 C 2 FORMAT(' YYM=',F6.2,' YY=',F6.2,' IAQ=',I3,' IBQ=',I3,
69000 C . ' XINTIN=',F7.2,'XINT=',F7.2,'NINT=',I3,'MAXL=',F5.1,
69100 C .'XAX=',F5.1/)
69200 C
69300 C CHANGE YY AND YYM TO BE OUTPUT - POS AND NEG NUMBER OF INTERVALS
69400 C
69500 YY=-(IBQ*SS)
69600 YYM=IAQ
69700 XINT=XX(I)
69800 NDIG=1
69900 IF (I .EQ. 4 .or. i .eq. 1) NDIG=2
70000 RETURN
70100 END
70200 C
70300 C***********************************************************
70400 C
70500 SUBROUTINE PLACET(XTITLE,BX,SIZE,NCHARS,IBL,A,Q,XC)
70600 DIMENSION XTITLE(1)
70700 DO 1 I=1,12
70800 IF (XTITLE(I) .NE. ' ') GO TO 2
70900 1 CONTINUE
71000 NCHARS=0
71100 IBL=0
71200 GO TO 9
71300 2 IBL=I
71400 DO 3 I=IBL,12
71500 IF (XTITLE(I) .EQ. ' ') GO TO 4
71600 3 CONTINUE
71700 4 IEL=I-1
71800 NCHARS=(IEL-IBL+1)*5
71900 AA=A
72000 5 IF (AA*NCHARS .LT. (Q-XC)) GO TO 6
72100 AA=AA-.01
72200 IF (AA .GE. A-.03) GO TO 5
72300 GO TO 7
72400 6 SIZE=AA
72500 GO TO 8
72600 7 TYPE 71,(XTITLE(I),I=1,12),SIZE,A,Q,XC
72700 71 FORMAT(' WARNING: TITLE TOO LONG FOR AXIS LENGTH'/
72800 . 5X,12A5/5X,4F7.2/)
72900 8 BX=(Q-XC)/2.+XC-SIZE*NCHARS/2.-.1
73000 9 RETURN
73100 END
73200 C**************************************************************
73300 C
73400 C SUBROUTINE DOLOG - TO DO LOG SCALING
73500 C
73600 SUBROUTINE DOLOG(MIN,MAX,MAXL,K)
73700 REAL MIN,MAX,MAXL
73800 COMMON/XYSPEC/XINTIN(2),XAX(2),XINT(2),NINT(2)
73900 . ,XLAB(2),IZX(2),ILAG(2,2),IQ,IQQ
74000 DIMENSION ILAB(2,-1/3)
74100 DATA ILAB/'THOUS','ANTHS',' ',
74200 . ' ','THOUS','ANDS ','MILLI','ONS ','TRILL','IONS'/
74300 QQ=MIN
74400 DO 10 I=9,-3,-3
74500 IF (QQ/10.**I .GE. 1.) GO TO 12
74600 10 CONTINUE
74700 12 IQ=I
74800 I=IQ+2
74900 IF (QQ/10**I .GE. 1.) GO TO 15
75000 I=I-1
75100 IF (QQ/10**I .GE. 1) GO TO 15
75200 I=I-1
75300 15 IQQ=I-IQ
75400 C TYPE 1001,IQ,IQQ
75500 C1001 FORMAT(' IN DOLOG IQ=',I5,' IQQ=',I5/)
75600 ILAG(1,K)=ILAB(1,IQ/3)
75700 ILAG(2,K)=ILAB(2,IQ/3)
75800 X=10.**IQQ
75900 XLAB(K)=X
76000 DO 20 I=1,20
76100 IF (X .GE. MAX/10.**IQ) GO TO 25
76200 20 X=X*10.
76300 25 NINT(K)=I-1
76400 XINTIN(K)=MAXL/FLOAT(NINT(K))
76500 XAX(K)=MAXL
76600 IZX(K)=1
76700 C TYPE 1000,IQ,IQQ,XLAB(K),NINT(K),XINTIN(K),XAX(K),IZX(K)
76800 C1000 FORMAT(' IN DOLOG'/' IQ=',I4,' IQQ=',I4,'XLAB=',F8.1,' NINT=',
76900 C . I4,' XINTIN=',F8.2,' XAX=',F8.1,' IZX=',I4/)
77000 RETURN
77100 END