Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/bmd/bmd05d.for
There is 1 other file named bmd05d.for in the archive. Click here to see a list.
C GENERAL PLOT WITH HISTOGRAM APRIL 1, 1966
C THIS IS A SIFTED VERSION OF BMD05D ORIGINALLY WRITTEN IN
C FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
C IT WAS THEN CONVERTED TO 360 FORTRAN IV (H-LEVEL)
DIMENSION FG(120),X(5000),NX(15),HEAD(54),XMI(500),XMA(500),
1Z(15),NXX(15)
COMMON SYM(15),XY(51,34),X,HEAD,Z
C
EQUIVALENCE (FG,XMI)
DOUBLE PRECISION A123,B123,C123,D123,TODE,SAME
C
110 FORMAT ('1BMD05D GENERAL PLOT - INCLUDING HISTOGRAM',
* ' - REVISED FEBRUARY 17, 1969'/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA /)
DATA A123/6HFINISH/
DATA B123/6HPROBLM/
DATA C123/6HCRSVAR/
DATA D123/6HSELECT/
DATA YES/'YES'/
DATA BLANK/' '/
DATA NO/' NO'/
DATA RE / 'NO' /
NTAPE=5
CALL USAGEB('BMD05D')
5 READ(5,101) TODE,SAME,NV,NP,NG,NADD,REW,NTRAN,MTAPE,NCARD
204 FORMAT(45H0CONTROL CARDS INCORRECTLY ORDERED OR PUNCHED)
IF(TODE .NE. A123) GO TO 200
GO TO 201
800 PRINT 801, TODE
GO TO 202
802 PRINT 803
GO TO 202
804 PRINT 805
GO TO 202
806 PRINT 807
GO TO 202
808 PRINT 809
GO TO 202
810 PRINT 811
GO TO 202
812 PRINT 813
GO TO 202
814 PRINT 815, TODE
GO TO 202
816 PRINT 817
GO TO 202
818 PRINT 819
GO TO 202
820 PRINT 821, TODE
202 WRITE (6,204)
201 IF(NTAPE-5)308,308,307
307 REWIND NTAPE
308 CALL EXIT
200 IF(TODE .NE. B123) GO TO 800
203 IF (REW.NE.RE) CALL TPWD(MTAPE,NTAPE)
IF (REW.EQ.RE) GO TO 3050
GO TO 306
3050 IF (MTAPE.EQ.BLANK) NTAPE = 5
IF (MTAPE.NE.BLANK) NTAPE = MTAPE
306 IF(NV*(NV-501))309,802,802
309 IF((NP-1)*(NP-20001))205,804,804
205 IF((NV+NADD)*NP-5000) 206,206,806
206 IF(NCARD.GT.0.AND.NCARD.LE.10)GO TO 207
NCARD=1
WRITE(6,4000)
207 WRITE (6,110)
WRITE (6,210)SAME,NV,NP,NG,NADD,NTRAN,NCARD
IF (REW.EQ.RE) WRITE(6,1210) NO
IF (REW.NE.RE) WRITE(6,1210) YES
71 NTOT=NP*NV-NP
IF((NV+NADD)*(NV+NADD-501))1,808,808
1 NCARD=NCARD*18
READ (5,102)(FG(I),I=1,NCARD)
PRINT 1031,(FG(I),I=1,NCARD)
1031 FORMAT ('0',' VARIABLE FORMAT CARD(S)'/1X,18A4)
NCARD=NTOT+NP
DO 211 I=1,NCARD
211 X(I)=0.0
70 DO 3 I=1,NP
C ***** READ IN THE RAW DATA AND TRANSPOSE THE MATRIX
READ (NTAPE,FG)(XMA(J), J=1,NV)
DO 3 J=1,NV
K=NP*J-NP+I
3 X(K)=XMA(J)
IF(NTRAN) 810,22,21
21 CALL TRANS(NP,NV,NTRAN)
IF(NV) 812,812,22
22 NPV=NP
NV=NV+NADD
K=1
DO 63 I=1,NV
XMI(I)=99999999.0
XMA(I)=-99999999.0
DO 64 J=K,NPV
XMI(I)= AMIN1(X(J),XMI(I))
64 XMA(I)= AMAX1(X(J),XMA(I))
K=K+NP
63 NPV=NPV+NP
DO 50 JJ=1,NG
READ (5,104)TODE,NH,NL,NC,NY,FN
IF(TODE .NE. D123) GO TO 814
209 IF(NH*(NH-3))215,816,816
215 NH=NH*18
READ (5,102)(HEAD(I),I=1,NH)
IF(NC) 818,20,8
8 NNC=(NC+6)/7
IF(NNC-2)9,9,818
9 NG2=0
DO 150 I=1,NNC
NG1=NG2+1
NG2=NG2+7
READ (5,105)TODE,(NX(J),SYM(J),J=NG1,NG2)
IF(TODE .NE. C123) GO TO 820
150 CONTINUE
XMAX=-99999999.0
XMIN=99999999.0
IF(NC-1)20,11,12
11 J=NX(1)
XMAX=XMA(J)
XMIN=XMI(J)
GO TO 14
12 DO 13 I=1,NC
J=NX(I)
XMAX= AMAX1(XMAX,XMA(J))
13 XMIN= AMIN1(XMIN,XMI(J))
14 NPV=0
10 DO 65 I=1,NC
65 NXX(I)=NX(I)*NP-NP
NYY=NY*NP-NP
IF(NL)23,23,24
24 WRITE (6,110)
IF(9-NC)242,249,249
242 WRITE (6,108)NY,(NX(I),I=1,9)
WRITE (6,112)
WRITE (6,111)(NX(I),I=10,NC)
GO TO 250
249 WRITE (6,108)NY,(NX(I),I=1,NC)
250 WRITE (6,112)
DO 26 I=1,NP
MY=NYY+I
Y=X(MY)
DO 25 J=1,NC
MX=NXX(J)+I
25 Z(J)=X(MX)
26 WRITE (6,106)Y,(Z(K),K=1,NC)
23 WRITE (6,110)
WRITE (6,103)(HEAD(I),I=1,NH)
WRITE (6,4444) NY, (NX(ICK),SYM(ICK),ICK=1,NC)
4444 FORMAT (2X,'PLOT OF VARIABLE',I3, ' (VERTICAL AXIS) VERSUS VARIAB
*LE(S)', I3,' (SYMBOL=', A1,'),', 7(I3,'(',A1,'),') /
* 56X, 6(I3, '(',A1, '),'))
NNP=FN
YMAX=XMA(NY)
YMIN=XMI(NY)
DO 16 I=1,NP
ASSIGN 155 TO ISKIP
MY=NYY+I
Y=X(MY)
DO 15 J=1,NC
MX=NXX(J)+I
15 Z(J)=X(MX)
GO TO ISKIP,(155,157)
155 CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
ASSIGN 157 TO ISKIP
GO TO 16
157 CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
16 CONTINUE
IF(NNP)31,32,32
31 NC=-1
GO TO 33
32 NC=0
33 CALL PLOTR(Y,YMIN,YMAX,Z,SYM,XMIN,XMAX,NC,NNP)
GO TO 50
20 NYT=NY*NP
NYY=NYT-NP+1
IF(NL)29,29,28
28 WRITE (6,110)
NNC=(NP+9)/10
NG2=NYY-1
WRITE (6,107)NY
DO 285 I=1,NNC
NG1=NG2+1
NG2=NG2+10
IF(NYT-NG2)283,284,284
283 NG2=NYT
284 WRITE (6,125)(X(J),J=NG1,NG2)
285 CONTINUE
29 WRITE (6,110)
WRITE (6,103)(HEAD(I),I=1,NH)
WRITE (6,707) NY
707 FORMAT (' HISTOGRAM OF VARIABLE ', I3)
XMAX=XMA(NY)
XMIN=XMI(NY)-.0000005
IF((XMAX-XMIN)/FN-34.0)34,34,35
35 FN=(XMAX-XMIN)/34.0
WRITE (6,109)FN
34 CALL HIST(NYY,NYT,XMIN,XMAX,FN,NP)
50 CONTINUE
GO TO 5
C
101 FORMAT(2A6,I3,I5,I3,I4,36X,A2,I3,2I2)
102 FORMAT(18A4)
103 FORMAT(24X,18A4)
104 FORMAT(A6,2I1,I2,I3,F11.0)
105 FORMAT(A6,7(I3,A4,2X))
106 FORMAT(1H 10(F10.4,1X))
107 FORMAT(1H 23H HISTOGRAM OF VARIABLE I3//)
108 FORMAT(14H BASE VARIABLE,38X, 16H CROSS VARIABLES/6X,10(I3,8X))
109 FORMAT(1H ,54H THE VALUE GIVEN FOR THE INTERVAL WIDTH IS TOO SMALL
1. /13H A NEW VALUE,F11.4,22H,HAS BEEN SUBSTITUTED.//)
111 FORMAT(5X,5(I3,8X))
112 FORMAT(1H )
125 FORMAT(1H 10F11.4)
210 FORMAT(14H PROBLEM CODE ,3(2H. ),1X,A6/18H NO. OF VARIABLES ,
13(2H. ),I3/14H NO. OF CASES ,4(2H. ),I5/24H NO. OF SELECTION CARDS
2 ,I3/24H NO.OF VARIABLES ADDED ,I3/22H NO. OF TRNGEN CARDS ,2H. ,
3I3/22H NO. OF FORMAT CARDS ,2H. ,I3)
1210 FORMAT (' REWIND INPUT TAPE .... ',A3)
801 FORMAT(' PROGRAM EXPECTED PROBLM OR FINISH CARD INSTEAD READ THE
1 FOLLOWING'/1X,A6)
803 FORMAT(' NUMBER OF VARIABLES INCORRECTLY SPECIFIED')
805 FORMAT(' NUMBER OF CASES INCORRECTLY SPECIFIED')
807 FORMAT(' TOTAL DATA INPUT CANNOT EXCEED 20,000')
809 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION CANNOT EXCEED 5
100')
811 FORMAT(' PROBLM CARD ERROR'/' NUMBER OF TRANSGENERATION CARDS IS N
1EGATIVE')
813 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION HAS BECOME LESS
1 THAN OR EQUAL TO ZERO')
815 FORMAT(' PROGRAM EXPECTED SELECT CARD INSTEAD READ THE FOLLOWING'/
11X,A6)
817 FORMAT(' NUMBER OF HEADING CARDS INCORRECTLY SPECIFIED')
819 FORMAT(' NUMBER OF CROSS VARIABLES TO APPEAR ON GRAPH IS INCORRECT
LY SPECIFIED'/' ERROR ON SELECT CARD')
821 FORMAT(' PROGRAM EXPECTED CRSVAR CARD INSTEAD READ THE FOLLOWING'/
11X,A6)
4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
1IED, ASSUMED TO BE 1.)
C
END
C SUBROUTINE HIST FOR BMD05D APRIL 1, 1966
SUBROUTINE HIST(NYY,NYT,XMIN,XMAX,SYMB,NP)
COMMON SYM(15),XY(51,34),X,HEAD,Z
DIMENSION X(5000),K000FX(35),XM(3),D(3),Z(15),BONE(3),CLAB(36)
C
DATA TEMP1/3H /
DATA TEMP2/1H+/
DATA TEMP3/1H./
DATA TOPPER/3H---/,FILLER/3H111/
23 FORMAT(1H F5.1,1X,A1,34A3,A1,1X,F5.1)
101 FORMAT (5X,17(F5.1,1X),F5.1/8X,17(F5.1,1X)/8X,17('+++...'))
102 FORMAT(8X,17('+++...')/5X,17(F5.1,1X),F5.1/8X,17(F5.1,1X))
4000 FORMAT( 8H MIN = ,F12.6,80X,7H MAX = ,F12.6)
M=1
WRITE (6,4000)XMIN,XMAX
DO 50 I=1,35
50 K000FX(I)=0
DO 100 K=1,34
DO 100 J=1,50
100 XY(J,K) = TEMP1
MINH=XMIN/SYMB
TXMIN=XMIN/SYMB-1.0
CLAB(1)=XMIN
DO 16 I=2,35
16 CLAB(I)=CLAB(I-1)+SYMB
WRITE (6,101) (CLAB(I),I=1,35,2),(CLAB(J),J=2,34,2)
DO 1 I=NYY,NYT
K=X(I)/SYMB-TXMIN
K000FX(K)=K000FX(K)+1
IF(K000FX(M)-K000FX(K))8,1,1
8 M=K
1 CONTINUE
YMAX=K000FX(M)
SC=50.0
32 IF(YMAX-SC)30,30,31
31 SC=SC+50.0
GO TO 32
C
30 SC = 50.0 / SC
15 DO 6 I=1,34
XL = K000FX(I)
L = XL * SC + 0.5
IF(L) 5,6,5
5 XY(L,I) = TOPPER
L=L-1
IF(L)11,6,11
11 DO 10 K=1,L
10 XY(K,I) = FILLER
6 CONTINUE
DO 7 K=1,50
L=51-K
R=L
R=R/SC
I=MOD(K,5)
IF(I-1)2,3,2
3 W = TEMP2
GO TO 7
2 W = TEMP3
7 WRITE (6,23)R,W,(XY(L,M),M=1,34),W,R
WRITE (6,102) (CLAB(I),I=1,35,2),(CLAB(J),J=2,34,2)
RETURN
END
SUBROUTINE TPWD(NT1,NT2)
C SUBROUTINE TPWD FOR BMD05D APRIL 1, 1966
IF(NT1)40,10,12
10 NT1=5
12 IF(NT1-NT2)14,19,14
14 IF(NT2.EQ.5)GO TO 18
17 REWIND NT2
19 IF(NT1-5)18,24,18
18 IF(NT1-6)22,40,22
22 REWIND NT1
24 NT2=NT1
28 RETURN
40 WRITE (6,49)
STOP
49 FORMAT(25H ERROR ON TAPE ASSIGNMENT)
END
SUBROUTINE TRANS(N,NJ,NTR)
C SUBROUTINE TRANS FOR BMD05D APRIL 1, 1966
C
COMMON DUM(15),UJUNK(51,34),DATA(5000)
DOUBLE PRECISION C123,TODE
ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
C
DATA C123/6HTRNGEN/
C
ON=N+1
MARY=0
WRITE (6,1403)
WRITE (6,1400)
IERROR=0
DO 1000 I=1,NTR
READ (5,900)TODE,NE,NC,NV,CO
IF(TODE .EQ. C123) GO TO 6
300 NJ=-NJ
RETURN
6 WRITE (6,1402)I,NE,NC,NV,CO
MA=N*NE-N
MB=N*NV-N+1
MC=MB+N-1
IF(NC*(15-NC))1500,1500,2
2 IF(NC-11) 4, 3, 3
3 K=CO
MD=N*K-N
4 DO 210 J=MB,MC
D1=DATA(J)
MA=MA+1
MD=MD+1
5 CONTINUE
GO TO (10,20,30,40,50,60,70,80,90,100,110,120,130,140),NC
10 IF(D1)99,32,8
8 D2=SQRT(D1)
GO TO 200
20 IF(D1)99,11,12
11 D2=1.0
GO TO 200
12 D2=SQRT(D1)+SQRT(D1+1.0)
GO TO 200
30 IF(D1)99,99,14
14 D2=ALOG10(D1)
GO TO 200
40 D2=EXP(D1)
GO TO 200
50 IF(D1)99,32,17
17 IF(D1-1.0)18,19,99
19 D2=3.14159265/2.0
GO TO 200
18 D2=ASN(SQRT(D1))
GO TO 200
60 A=D1/ON
B=A+1.0/ON
IF(A)99,23,24
23 IF(B)99,32,27
27 D2=ASN(SQRT(B))
GO TO 200
24 IF(B)99,28,29
28 D2=ASN(SQRT(A))
GO TO 200
29 A=SQRT(A)
B=SQRT(B)
D2=ASN(A)+ASN(B)
GO TO 200
70 IF(D1)31,99,31
31 D2=1.0/D1
GO TO 200
80 D2=D1+CO
GO TO 200
90 D2=D1*CO
GO TO 200
100 IF(D1)33,32,33
32 D2=0.0
GO TO 200
33 D2=D1**CO
GO TO 200
110 D2=D1+DATA(MD)
GO TO 200
120 D2=D1-DATA(MD)
GO TO 200
130 D2=D1*DATA(MD)
GO TO 200
140 IF(DATA(MD))157,99,157
157 D2=D1/DATA(MD)
GO TO 200
99 IF(MARY)43,44,44
44 MARY=-999
IERROR=-999
WRITE (6,1404)I
43 WRITE (6,1405)J
GO TO 210
200 DATA(MA)=D2
210 CONTINUE
MARY=0
1000 CONTINUE
IF(IERROR)42,1111,1111
42 WRITE (6,1401)
1111 RETURN
C
900 FORMAT(A6,I3,I2,I3,F6.0)
1500 WRITE (6,1406)
GO TO 1000
C
1400 FORMAT(46H0CARD NEW TRANS ORIG. ORIG. VAR(B)/45H NO.
1VARIABLE CODE VAR(A) OR CONSTANT)
1401 FORMAT(78H VALUES OF VARIABLES OF WHICH AN ERROR WAS FOUND DURING
1TRANS-GENERATION WILL /77H STILL BE INCLUDED IN THE GRAPHS. HOWEVE
2R, THESE GRAPHS MAY BE MEANINGLESS /54H SINCE SOME VALUES WILL B
3E TRANSFORMED AND OTHERS NOT.)
1402 FORMAT(2H I2,I8,2I9,4X,F10.5)
1403 FORMAT(1H06X,23HTRANS GENERATOR CARD(S))
1404 FORMAT(55H0THE INSTRUCTIONS INDICATED ON TRANS GENERATOR CARD NO.I
12,1X,3HRE-/60H SULTED IN THE VIOLATION OF A RESTRICTION FOR THIS T
2RANSFOR-/59H MATION. THE VIOLATION OCCURRED FOR THE ITEMS LISTED B
3ELOW.)
1405 FORMAT(10H ITEM NO. I5)
1406 FORMAT(107H0TRANSGENERATION CODE ON CARD LISTED ABOVE IS INCORRECT
1. PROGRAM WILL PROCEED WITHOUT THIS TRANSGENERATION.)
C
END
SUBROUTINE PLOTR(X,ZMIN,ZMAX,Y,SYM,WMIN,WMAX,NC,NP)
C SUBROUTINE PLOTR (IBM 360) AUGUST 13, 1966
C
C 'PLOTR' IS A UTILITY SUBPROGRAM FOR THE BMD... PROGRAMS WHICH
C PLOTS EITHER SINGLE-LINE OR WHOLE-PAGE GRAPHS AND SETS UP
C APPROPRIATE SCALING. THE CALLING PARAMETERS ARE AS FOLLOWS -
C
C X - THE VALUE OF THE INDEPENDENT VARIABLE
C ZMIN - THE MINIMUM VALUE OF X FOR THIS PLOT
C ZMAX - THE MAXIMUM VALUE OF X FOR THIS PLOT
C Y - THE ARRAY CONTAINING THE VALUES OF UP TO 15 DEPENDENT VAR.'S
C SYM - THE ARRAY CONTAINING THE SYMBOLS TO BE PLOTTED
C WMIN - THE MINIMUM VALUE OF ALL Y'S FOR THIS PLOT
C WMAX - THE MAXIMUM VALUE OF ALL Y'S FOR THIS PLOT
C NC - THE NUMBER OF DEPENDENT VARIABLES
C NC=-1 CLOSES A SINGLE-LINE PLOT
C NC= 0 PRINTS AND CLOSES A WHOLE-PAGE PLOT
C NP - THE CONTROL VARIABLE
C NP=-1 PRINTS A SINGLE LINE
C NP=0 OR NP=1 SETS UP A WHOLE-PAGE PLOT
C
C THE PLOTTING ROUTINE MUST BE CALLED ONCE FOR EACH VALUE OF THE
C INDEPENDENT VARIABLE THAT IS TO BE PLOTTED NO MATTER WHETHER IN
C THE SINGLE-LINE OR WHOLE-PAGE MODE
C
DIMENSION Y(15),CLAB(12),GF(10),FMT(12),XY(51,101),SYM(15)
INTEGER XY,BLANKS
DATA TC,TP,BLANKS/1H.,1H+,1H /
DATA GF/ 4H 1X,,4H 2X,,4H 3X,,4H 4X,,4H 5X,,4H 6X,,
14H 7X,,4H 8X,,4H 9X,,4H 10X/
DATA FMT/'(17X',' ','5(F1','2.3,','8X)/','7X, ',' ','4(F1','2.3,',
1'8X),','F12.','3) '/
C
100 FORMAT(1H 6X5(F12.3,8X),F12.3/17X,5(F12.3,8X))
101 FORMAT(1H F12.3,1X,103A1,F12.3)
102 FORMAT (1H 13X,103A1)
1000 FORMAT(1H 14X,101A1)
1001 FORMAT(15X,20(5H+....),1H+)
C
DATA NCC/2/
C 'NCC' ON THE INITIAL ENTRY TO PLOTR IS NON-ZERO BECAUSE OF THE DATA
C STATEMENT ABOVE.
C
C 'NCC' IS 0 WHILE A PLOT IS BEING MADE. IT IS 1 OR 2 AT OTHER TIMES
C
IF(NCC) 50,48,50
C
C THE VARIABLE 'KL' CONTROLS THE FUNCTIONING OF THE OPENING AND
C CLOSING SECTIONS OF PLOTR. KL=0 INDICATES OPENING OF THE GRAPH,
C KL=1 INDICATES CLOSING.
C
50 KL=0
CALL SCALE(WMIN,WMAX,100.0,JY,YMIN,YMAX,YIJ)
YR=YMAX-YMIN
230 J=JY
IF(J*(J-10))204,201,201
C
C THE FOLLOWING SECTION OPENS OR CLOSES A PLOT IN FIXED FORMAT
C UNDER CONTROL OF KL
C
201 IF(KL)220,220,231
C
231 WRITE (6,1001)
IF(KL)250,250,220
C
220 CLAB(1)= YMIN
DO 222 I=2,11
222 CLAB(I)=CLAB(I-1)+YIJ
WRITE (6,100)(CLAB(I),I=1,11,2),(CLAB(J),J=2,10,2)
IF(KL)231,231,14
C
C THE FOLLOWING SECTION OPENS OR CLOSES A PLOT IN A VARIABLE
C FORMAT UNDER CONTROL OF KL AND JY FROM 'SCALE'
C
204 IF(J-5)205,221,207
207 J=J-5
205 JYT=5-J
221 CONTINUE
226 FMT(2)=GF(JY)
IF (KL) 225,225,227
C
225 FMT(7)=GF(JY)
TT=JY
TT=TT*YIJ/10.0
CLAB(1)= YMIN+TT
DO 223 I=2,10
223 CLAB(I)=CLAB(I-1) +YIJ
WRITE (6,FMT)(CLAB(I),I=2,10,2),(CLAB(I),I=1,9 ,2)
IF(KL)227,227,14
C
227 IF(JY-5)208,209,208
208 WRITE(6,1000)(TC,I=1,J ),(TP,(TC,I=1,4),K=1,19),TP,(TC,I=1,JYT)
IF (KL) 250,250,225
C
209 WRITE (6,1001)
IF (KL) 250,250,225
C
250 CONTINUE
NCC=0
IC=0
IF(NP)80,11,11
C
C THIS SECTION PREPARES FOR A FULL PAGE PLOT BY FILLING IN XY WITH
C BLANKS AND SETTING UP SCALING FOR THE INDEPENDENT VARIABLE 'X'
C
11 DO 1 I=1,51
DO 1 J=1,101
1 XY(I,J)=BLANKS
CALL SCALE (ZMIN,ZMAX,50.0,JX,XMIN,XMAX,XIJ)
XR=XMAX-XMIN
GO TO 48
C
C
C ENTRY TO PLOTS CAN BE USED ONLY AFTER THE CALLING PARAMETERS
C HAVE BEEN TRANSFERRED BY A CALL ON PLOTR. THE CALL ON PLOTS
C IS IDENTICAL WITH ENTRY TO PLOTR BUT IT ALLOWS THE PROGRAMMER TO
C CALL THE PLOTTING ROUTINE WITHOUT HAVING TO INCLUDE THE PARAMETERS
C
48 IF(NC)52,13,49
49 IF(NP)80,10,10
C THE FOLLOWING SECTION SETS UP A FULL PAGE BUT DOES NO PRINTING.
C THIS SECTION IS REACHED BY SPECIFYING NC POSITIVE AND NP POSITIVE.
C
10 DO 9 N=1,NC
SYMB=SYM(N)
XDIFFR=XMAX-X
IF(XDIFFR)105,106,106
105 XDIFFR=0.0
106 YDIFFR=YMAX-Y(N)
IF(YDIFFR)107,108,108
107 YDIFFR=0.0
108 L=51.0-(50.0*XDIFFR)/XR+.5
K=101.0-(100.0*YDIFFR)/YR+.5
CALL FORM2(SYMB,XY(L,K))
9 CONTINUE
GO TO 15
C
C THE FOLLOWING SECTION CONSTRUCTS AND PLOTS ONE LINE OF A MULTILINE
C GRAPH. LOCATION ALONG THE AXIS OF THE PAPER IS PRINTED AT EVERY
C STEP. THIS SECTION IS ACCESSIBLE BY SPECIFYING NC POSITIVE AND
C NP NEGATIVE.
C
80 DO 86 I=1,101
86 XY(1,I)=BLANKS
L=1
DO 95 N=1,NC
SYMB=SYM(N)
YDIFFR=YMAX-Y(N)
IF(YDIFFR)860,865,865
860 YDIFFR=0.0
865 K=101.0-(100.0*YDIFFR)/YR+.5
95 CALL FORM2(SYMB,XY(L,K))
IF(MOD(IC,5))97,96,97
96 W=TP
GO TO 98
97 W=TC
98 WRITE (6,101)X,W,(XY(1,N),N=1,101),W,X
IC=IC+1
GO TO 15
C
C THIS SECTION PLOTS OUT THE PREVIOUSLY PREPARED WHOLE PAGE GRAPH.
C IT PRINTS LOCATION ALONG THE PAPER'S AXIS EVERY FIFTH STEP. THIS
C SECTION IS ACCESSED BY SPECIFYING NC=0.
C
13 M=6-JX
LL=50+M
T=JX
IF(5-JX)131,131,135
131 T=0.0
135 RLAB=XMAX-(T*XIJ)/5.0
W=TC
K=52
DO 31 L=M,LL
K=K-1
I=MOD(L,5)
IF(I-1)2,3,2
3 W=TP
WRITE (6,101)RLAB,W,(XY(K,N),N=1,101),W,RLAB
RLAB=RLAB-XIJ
W=TC
GO TO 31
2 WRITE (6,102)W,(XY(K,N),N=1,101),W
31 CONTINUE
C
52 KL=1
GO TO 230
C
14 NCC=1
15 RETURN
END
SUBROUTINE SCALE(YMIN,YMAX,YINT,JY,TYMIN,TYMAX,YIJ)
C SUBROUTINE SCALE FOR PLOTR JUNE 21, 1966
C
C SUBROUTINE 'SCALE' CALCULATES THE SCALING FOR 'PLOTR'
C
DIMENSION C(10)
DATA C /1.0,1.5,2.0,3.0,4.0,5.0,7.5,10.0,15.0,20.0/
DATA TEST / 0.76293945E-05/
50 YR=YMAX-YMIN
TT=YR/YINT
J = ALOG10(TT)+TEST
E=10.0**J
TT=TT/E
I=0
IF(TT-1.0+TEST)205,201,201
205 TT=TT*10.0
E=E/10.0
201 I=I+1
IF(9-I)1,2,2
1 E=E*10.0
I=1
2 IF(TT-C(I))233,202,201
233 YIJ=C(I)*E
GO TO 203
202 Y=YMIN/C(I)
J=Y
T=J
IF(0.0001-ABS(T-Y))204,233,233
204 YIJ=C(I+1)*E
203 X=((YMAX+YMIN)/YIJ-YINT )/2.0+.00001
K=X
IF(K)235,240,240
235 Y=K
IF(X-Y)236,240,236
236 K=K-1
240 TYMIN=K
TYMIN=YIJ*TYMIN
TYMAX=TYMIN+YINT*YIJ
IF (YMAX-TYMAX-TEST)11,11,201
11 YIJJ=C(I)*E
XT=((YMAX+YMIN)/YIJJ-YINT)/2.0+.00001
KT=XT
IF (KT) 1235,1240,1240
1235 YT=KT
IF (XT.NE.YT) KT=KT-1
1240 TYMINT=KT
TYMINT=YIJJ*TYMINT
TYMAXT=TYMINT+YINT*YIJJ
IF(YMAX-TYMAXT.GT.TEST)GO TO 10
TYMIN=TYMINT
TYMAX=TYMAXT
YIJ=YIJJ
K=KT
10 TT=YINT/10.0
JY=TT+.000001
YIJ=YINT*(YIJ/10.0)
J=TYMIN/YIJ
IF(K)242,241,241
242 J=J-1
241 J=J*JY+JY-K
JY=J
RETURN
END
SUBROUTINE FORM2(SYMB,XY)
DIMENSION TEST(18)
DATA BLANK/' '/,TEST/'2 ','3 ','4 ','5 ','6 ',
1'7 ','8 ','9 ','A ','B ','C ','D ','E ','F ','G ','H ','I ','/ '/
IF(XY.EQ.BLANK)GO TO 50
DO 30 I=1,17
IF(XY.NE.TEST(I))GO TO 30
C PUT IN NEXT SYMBOL OF ARRAY FOR MULTIPLE POINTS
XY=TEST(I+1)
GO TO 100
30 CONTINUE
IF(XY.EQ.TEST(18))GO TO 100
C IF OTHER THAN CHARACTERS IN ARRAY TEST PUT IN CHARACTER 2.
XY=TEST(1)
GO TO 100
C IF BLANK, PUT IN SYMBOL
50 XY=SYMB
100 RETURN
END