Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/csmp/csmp3.for
There is 1 other file named csmp3.for in the archive. Click here to see a list.
00100 SUBROUTINE CSM8(V,H,IOFSET,NSTP)
00200 C PRINT CONTROLLER
00300 INTEGER OU
00400 REAL IPLOT(0/100)
00500 DIMENSION V(1),H(1),KI(4)
00600 DIMENSION C(76)
00700 DIMENSION SYM(4)
00800 COMMON REALS(395),INTS(547)
00900 EQUIVALENCE (INTS(386),KEY7),(INTS(388),KEY9)
01000 EQUIVALENCE (INTS(535),K1),(INTS(536),K2)
01100 EQUIVALENCE (INTS(537),K3),(INTS(538),K4)
01200 EQUIVALENCE (INTS(539),NK)
01300 EQUIVALENCE (REALS(2),C(1)),(REALS(77),T)
01400 EQUIVALENCE (REALS(392),VDEL),(REALS(394),VMIN)
01500 EQUIVALENCE (KI(1),K1)
01600 DATA FBLANK,FDASH,FI,FPLUS/1H ,1H-,1HI,1H+/
01700 DATA SYM/'A','B','C','D'/
01800 COMMON /ODEVIM/OU
01900 GO TO (160,9,140,9),KEY7+2
02000 9 NMAX=100
02100 NZ=.5+50.*(-VMIN)/VDEL
02200 IF(OU.NE.5.AND.OU.NE.8.AND.OU.NE.19)GO TO 70
02300 NMAX=0
02400 DO 8 K=0,50
02500 8 IPLOT(K)=FBLANK
02600 DO 40 J=1,NK
02700 N=.5+50.*(C(KI(J))-VMIN)/VDEL
02800 IF(NZ.GE.0.AND.NZ.LE.50)IPLOT(NZ)=FI
02900 IF(N.GE.0.AND.N.LE.50)IPLOT(N)=SYM(J)
03000 40 NMAX=MAX0(NMAX,MIN0(N,50),MIN0(NZ,50))
03100 GO TO 100
03200 70 NZ=.5+100.*(-VMIN)/VDEL
03300 DO 92 K=0,100
03400 92 IPLOT(K)=FBLANK
03500 DO 90 J=1,NK
03600 N=.5+100.*(C(KI(J))-VMIN)/VDEL
03700 IF(NZ.GE.0.AND.NZ.LE.100.)IPLOT(NZ)=FI
03800 90 IF(N.GE.0.AND.N.LE.100.)IPLOT(N)=SYM(J)
03900 100 WRITE(OU,130)T,(IPLOT(I),I=0,NMAX)
04000 130 FORMAT(1H ,G9.3,1X,101A1)
04100 RETURN
04200 C PRINT ONLY
04300 140 IPLOT(1)=C(K1)
04400 IPLOT(2)=C(K2)
04500 IPLOT(3)=C(K3)
04600 IPLOT(4)=C(K4)
04700 WRITE(OU,150) T,(IPLOT(I),I=1,NK)
04800 150 FORMAT(1H ,G11.5,4G13.6)
04900 RETURN
05000 C GRAPHING
05100 160 DO 162 I=1,NK
05200 ISS=NSTP+(I-1)*IOFSET
05300 V(NSTP+(I-1)*IOFSET)=C(KI(I))
05400 162 H(NSTP+(I-1)*IOFSET)=T
05500 END
00100 SUBROUTINE CSM8A(IOFSET)
00200 C PRINT SPECIFICATIONS
00300 INTEGER PRINT(4),TEST8,OU
00400 COMMON REALS(395),INTS(547)
00500 EQUIVALENCE (INTS(384),KEY5),(INTS(385),KEY6)
00600 EQUIVALENCE (INTS(386),KEY7),(INTS(388),KEY9)
00700 EQUIVALENCE (INTS(532),TEST8),(INTS(535),PRINT(1)),(INTS(539),NK)
00800 EQUIVALENCE (REALS(78),DT),(REALS(391),TSAMP)
00900 EQUIVALENCE (REALS(392),VDEL),(REALS(394),VMIN)
01000 EQUIVALENCE (REALS(80),TTOT)
01100 C
01200 COMMON /ODEVIM/OU
01300 COMMON /NOSTOP/ITHROU
01400 C
01500 IF (ITHROU.EQ.1)GO TO 270
01600 WRITE(30,10)
01700 10 FORMAT(/10X,14HOUTPUT CONTROL/)
01800 C PRINT INTERVAL SPECIFICATION
01900 20 WRITE(30,30)
02000 30 FORMAT(16H PRINT INTERVAL=$)
02100 TSAMP=FINPUT(0,IERR)
02200 IF (IERR.NE.0) GO TO 20
02300 IF (FINPUT(-1,IERR).NE.0.0) GO TO 20
02400 IOFSET=INT(TTOT/TSAMP)+1
02500 IF (TSAMP.GE.DT) GO TO 60
02600 WRITE(30,50)
02700 50 FORMAT(56H PRINT INTERVAL CANNOT BE LESS THAN INTEGRATION INTERVAL
02800 1)
02900 GO TO 20
03000 C
03100 C PRINT VARIABLES SPECIFICATION
03200 60 CONTINUE
03300 IF(KEY7.EQ.1)GO TO 160
03400 C PRINT AND PLOT AND GRAPH
03500 100 FORMAT(18H NOT A LEGAL BLOCK/)
03600 110 WRITE(30,120)
03700 120 FORMAT(25H MINIMUM, MAXIMUM VALUES=$)
03800 VMIN=FINPUT(0,IERR)
03900 IF (IERR.NE.0) GO TO 110
04000 VMAX=FINPUT(0,IERR)
04100 IF (IERR.NE.0) GO TO 110
04200 IF (FINPUT(-1,IERR).NE.0.0) GO TO 110
04300 VDEL=VMAX-VMIN
04400 IF (VDEL.GT.0.0) GO TO 160
04500 C LET GRAPH PROG CALC MAX,MIN(OPTIONAL)
04600 IF(VDEL.EQ.0.AND.KEY7.LT.0)GO TO 160
04700 WRITE(30,150)
04800 150 FORMAT(36H MAXIMUM CANNOT BE LESS THAN MINIMUM/)
04900 GO TO 110
05000 160 WRITE(30,170)
05100 170 FORMAT(36H BLOCK A, BLOCK B, BLOCK C, BLOCK D=$)
05200 NK=0
05300 DO 190 I=1,4
05400 PRINT(I)=KINPUT(0,IERR)
05500 IF (IERR) 200,180,160
05600 180 IF (PRINT(I).LT.1.OR.PRINT(I).GT.75) GO TO 220
05700 NK=NK+1
05800 190 CONTINUE
05900 IF (FINPUT(-1,IERR).NE.0.0) GO TO 160
06000 200 IF (NK) 160,160,320
06100 220 WRITE(30,100)
06200 GO TO 160
06300 C PRINT ONLY HEADING
06400 250 IF (TEST8.EQ.2.AND.KEY7.NE.1) GO TO 270
06500 BLOCK='BLOCK'
06600 WRITE(OU,260) (BLOCK,PRINT(I),I=1,NK)
06700 260 FORMAT(1H1/5X,5HTIME ,4(5X,A5,I3))
06800 GO TO 320
06900 C
07000 270 GO TO (320,280,250,280),KEY7+2
07100 C PRINT AND PLOT HEADING
07200 280 IF (OU.NE.5.AND.OU.NE.8.AND.OU.NE.19) GO TO 300
07300 WRITE(30,290)VMIN,VMAX
07400 290 FORMAT(1H1,4HTIME,2X,G13.6,36X,G13.6/,11X,'+',10('----+'))
07500 GO TO 320
07600 300 WRITE(OU,310)VMIN,VMAX
07700 310 FORMAT(1H1,1X,4HTIME,2X,G13.6,86X,G13.6,/,11X,'+',20('----+'))
07800 C TEST8=1 UNTIL FIRST TIME THROUGH CSM8A
07900 C TEST8=2 AFTER FIRST TIME THROUGH CSM8A
08000 320 TEST8=2
08100 RETURN
08200 END
00100 SUBROUTINE CSM10(IOFSET)
00200 C ALLOCATOR FOR GRAPHING(DEALLOCATES OTHERWISE)
00300 DIMENSION S(1)
00400 COMMON REALS(395),INTS(547)
00500 EQUIVALENCE (INTS(386),KEY7),(INTS(539),NK),(INTS(529),TEST5)
00600 IF(KEY7.LT.0)GO TO 5
00700 CALL ALLCOR(1,IERR,I1,S)
00800 I2=I1
00900 GO TO 10
01000 5 MAX=NK*IOFSET*2
01100 CALL ALLCOR(MAX,IERR,I1,S)
01200 I2=I1+IOFSET*NK
01300 IF(IERR.GE.0)GO TO 10
01400 WRITE(30,8)
01500 8 FORMAT(' NOT ENOUGH CORE TO GRAPH, TRY INCREASING THE PRINT',/,
01600 1 ' INTERVAL OR DECREASING THE TOTAL TIME',/)
01700 TEST5=4
01800 RETURN
01900 10 CONTINUE
02000 CALL CSM10A(S(I1),S(I2),IOFSET)
02100 RETURN
02200 END
02300 SUBROUTINE CSM10A(V,H,IOFSET)
02400 C CONTROLS THE COMPUTATION AND OUTPUT
02500 DIMENSION V(1),H(1)
02600 INTEGER TEST5,ORDER(76)
02700 LOGICAL RSAC
02800 DIMENSION INTG(25),C(76),PAR1(75),Y(25),DYDT(25),YK(25)
02900 COMMON REALS(395),INTS(547)
03000 EQUIVALENCE (INTS(388),KEY9)
03100 EQUIVALENCE (INTS(396),INTG(1)),(INTS(449),ORDER(1))
03200 EQUIVALENCE (INTS(529),TEST5),(INTS(534),NLIST)
03300 EQUIVALENCE (INTS(542),NEQ),(INTS(546),IR)
03400 EQUIVALENCE (REALS(2),C(1)),(REALS(77),T),(REALS(78),DT)
03500 EQUIVALENCE (REALS(79),DTS2),(REALS(80),TTOT)
03600 EQUIVALENCE (REALS(81),PAR1(1)),(REALS(341),Y(1))
03700 EQUIVALENCE (REALS(366),DYDT(1)),(REALS(391),TSAMP)
03800 EQUIVALENCE (INTS(539),NK),(REALS(392),VDEL),(REALS(394),VMIN)
03900 EQUIVALENCE (INTS(386),KEY7)
04000 INTEGER OU
04100 COMMON /ODEVIM/OU
04200 NP=IOFSET
04300 C NORMAL SETUP
04400 DO 10 NEXT=2,NLIST
04500 I=ORDER(NEXT)
04600 10 C(I)=PAR1(I)
04700 T=0.0
04800 TZERO=0.0
04900 DO 20 NEXT=1,NEQ
05000 I=INTG(NEXT)
05100 20 Y(NEXT)=C(I)
05200 IR=7243
05300 EPSLN=DTS2/(TSAMP*2.0)
05400 TEST5=1
05500 N=1
05600 NSTP=0
05700 NN=T/TSAMP+1.0
05800 CALL CSM11
05900 C
06000 VMN=VMIN
06100 VMX=VDEL+VMN
06200 HMN=0
06300 HMX=TTOT
06400 C
06500 C START EXECUTION
06600 30 IF (RSAC(0)) GO TO 110
06700 40 GO TO (50,80,100,110,110,110),TEST5
06800 50 NSTP=NSTP+1
06900 CALL CSM8(V,H,IOFSET,NSTP)
07000 C FIRST HALF-STEP
07100 60 TEST5=2
07200 DO 70 NEXT=1,NEQ
07300 YK(NEXT)=Y(NEXT)
07400 70 Y(NEXT)=Y(NEXT)+DTS2*DYDT(NEXT)
07500 AXX=N
07600 TNEXT=AXX*DT+TZERO
07700 T=TNEXT-DTS2
07800 CALL CSM11
07900 GO TO 40
08000 C SECOND HALF STEP
08100 80 TEST5=3
08200 DO 90 NEXT=1,NEQ
08300 90 Y(NEXT)=YK(NEXT)+DT*DYDT(NEXT)
08400 T=TNEXT
08500 N=N+1
08600 CALL CSM11
08700 GO TO 30
08800 C TIME TO PRINT
08900 100 M=T/TSAMP+EPSLN
09000 IF (M.LT.NN) GO TO 120
09100 110 NSTP=NSTP+1
09200 CALL CSM8(V,H,IOFSET,NSTP)
09300 NN=M+1
09400 C IS RUN FINISHED
09500 120 IF (TEST5.GT.3) GO TO 150
09600 130 IF (RSAC(0)) GO TO 140
09700 IF (T-TTOT+DTS2) 60,150,150
09800 140 TEST5=5
09900 150 IF(OU.NE.5.AND.KEY7.GE.0)WRITE(OU,160)
10000 160 FORMAT(//1H1)
10100 C
10200 IF(KEY7.GE.0)GO TO 920
10300 C GRAPHING
10400 C VS - VERT. SCAL. PARAM.
10500 VS=-1
10600 C HS - HORZ. SCAL. PARAM.
10700 HS=-1
10800 C IV - Y AXIS PARAM.(LINEAR)
10900 IV=0
11000 C IH - X AXIS PARAM.(LINEAR)
11100 IH=0
11200 C IOPT - OPTION PARAM.
11300 C IOPT1 - PLOT DATA
11400 IOPT1=1
11500 C IOPT2 - PLOT AXIS WITH LABELS
11600 IOPT2=20
11700 C IOPT3 - NO BOX
11800 IOPT3=0
11900 C IOPT4 - PLOT ALL DATA
12000 IOPT4=0
12100 C IOPT5 - FULL SCREEN PLOT
12200 IOPT5=10000
12300 IOPT=IOPT1+IOPT2+IOPT3+IOPT4+IOPT5
12400 C IERASE - ERASE SCREEN BEFORE PLOTTING
12500 IERASE=1
12600 C ERR - PLOT MEDIUM
12700 ERR=20
12800 K=0
12900 C CONTINUOUS PLOT
13000 M=0
13100 DO 200 I=1,NP*NK,NP
13200 K=K+1
13300 CALL GPLOT(V(I),H(I),NP,VS,HS,IV,IH,IOPT,M,ERR,IERASE,
13400 1VMX,VMN,HMX,HMN)
13500 IF(I.NE.1)GO TO 85
13600 IERASE=0
13700 IOPT=IOPT-20
13800 C SET 5 OR 6 LABELS ON THE CURVE SO THEY DONT OVER LAP
13900 85 L=0
14000 DO 87 J=0,NP-K-1,NP/6
14100 L=L+1
14200 V(L)=V(I+J+K)
14300 H(L)=H(I+J+K)
14400 87 CONTINUE
14500 CALL GPLOT(V,H,L,VS,HS,IV,IH,IOPT,K+1,ERR,IERASE,
14600 1VMX,VMN,HMX,HMN)
14700 200 CONTINUE
14800 CALL ANMODE
14900 CALL HOME
15000 BNK=' '
15100 TYPE 910,(BLK,INTS(535+KK-1),KK=1,NK)
15200 910 FORMAT(' PRINT SYMBOLS:',/,A1,'"SQUARE" - BLOCK ',I2,A1,
15300 1' "X" - BLOCK ',I2,A1,' "+" - BLOCK ',I2,A1,
15400 1' "TRIANGLE" - BLOCK ',I2,/)
15500 920 RETURN
15600 END
15700 SUBROUTINE CSM11
15800 C DOES THE COMPUTATION REQUIRED
15900 C TO EVALUATE THE DERIVATIVE VECTOR
16000 C FOR ONE-HALF TIME STEP
16100 INTEGER TEST5,ORDER(76)
16200 LOGICAL RSAC,JUMP
16300 DIMENSION INTG(25),C(76),F(3,11),Y(25),DYDT(25)
16400 DIMENSION MTRX1(75),MTRX2(75),MTRX3(75),MTRX4(75),MTRX5(75)
16500 DIMENSION PAR1(75),PAR2(75),PAR3(75)
16600 COMMON REALS(395),INTS(547)
16700 EQUIVALENCE (INTS(1),MTRX1(1)),(INTS(76),MTRX2(1))
16800 EQUIVALENCE (INTS(151),MTRX3(1)),(INTS(226),MTRX4(1))
16900 EQUIVALENCE (INTS(301),MTRX5(1))
17000 EQUIVALENCE (INTS(396),INTG(1)),(INTS(449),ORDER(1))
17100 EQUIVALENCE (INTS(529),TEST5),(INTS(534),NLIST)
17200 EQUIVALENCE (INTS(540),NCON),(INTS(542),NEQ),(INTS(546),IR)
17300 EQUIVALENCE (REALS(2),C(1)),(REALS(78),DT),(REALS(79),DTS2)
17400 EQUIVALENCE (REALS(81),PAR1(1)),(REALS(156),PAR2(1))
17500 EQUIVALENCE (REALS(231),PAR3(1)),(REALS(306),F(1,1))
17600 EQUIVALENCE (REALS(341),Y(1)),(REALS(366),DYDT(1))
17700 C
17800 DO 10 I=1,NEQ
17900 J=INTG(I)
18000 10 C(J)=Y(I)
18100 NEXT=NCON
18200 20 I=ORDER(NEXT)
18300 P1=PAR1(I)
18400 P2=PAR2(I)
18500 P3=PAR3(I)
18600 J=MTRX2(I)
18700 K=MTRX3(I)
18800 L=MTRX4(I)
18900 IF (J.GE.0.AND.J.LE.76) CJ=C(J)
19000 IF (K.GE.0.AND.K.LE.76) CK=C(K)
19100 IF (L.GE.0.AND.L.LE.76) CL=C(L)
19200 M=MTRX1(I)
19300 C MODIFIED FOR BLOCKS A,C,E 25 APR 74.
19400 IF (M.LE.10) GO TO (1750,30,2750,40,3750,80,110,120,130,140),M
19500 M=M-10
19600 IF (M.LE.10) GO TO (650,150,180,190,210,220,230,240,270,290),M
19700 M=M-10
19800 GO TO (340,350,360,370,380,390,410,510,520),M
19900 C SPECIAL LOADABLE FUNCTIONS A,C,E ADDED 25 APR 74.
20000 C 'A' (DEFAULT IN CSMP4.F4 IS LOG(CJ) BASE E)
20100 1750 CI=BLOCKA(CJ,CK,CL,P1,P2,P3,JUMP)
20150 IF (JUMP) GO TO 750
20200 GO TO 600
20300 C 'C' (DEFAULT IN CSMP4.F4 IS COS(CJ+3.14159265*P1) )
20400 C (CJ IN RADIANS)
20500 2750 CI=BLOCKC(CJ,CK,CL,P1,P2,P3,JUMP)
20550 IF (JUMP) GO TO 750
20600 GO TO 600
20700 C 'E' (DEFAULT IN CSMP4.F4 IS EXP(CJ) )
20800 3750 CI=BLOCKE(CJ,CK,CL,P1,P2,P3,JUMP)
20850 IF (JUMP) GO TO 750
20900 GO TO 600
21000 C B - BANG-BANG
21100 30 CI=SIGN(1.0,CJ)
21200 GO TO 600
21300 C D - DEAD SPACE
21400 40 IF (CJ) 50,200,60
21500 50 DIFF=CJ-P2
21600 IF (DIFF) 70,200,200
21700 60 DIFF=CJ-P1
21800 IF (DIFF) 200,200,70
21900 70 CI=DIFF
22000 GO TO 600
22100 C F - FUNCTION GENERATOR
22200 80 NF=MTRX5(I)
22300 P3=P1-P2
22400 IF (P3.LE.0.0) GO TO 750
22500 P1=10.0*(CJ-P2)/P3
22600 IF (P1.GT.0.0) GO TO 90
22700 CI=F(NF,1)
22800 GO TO 600
22900 90 NSECT=P1
23000 IF (NSECT.LT.10) GO TO 100
23100 CI=F(NF,11)
23200 GO TO 600
23300 100 P2=NSECT
23400 P3=P1-P2
23500 P1=F(NF,NSECT+1)
23600 P2=F(NF,NSECT+2)
23700 CI=P1+P3*(P2-P1)
23800 GO TO 600
23900 C G - GAIN
24000 110 CI=P1*CJ
24100 GO TO 600
24200 C H - HALF POWER (SQUARE ROOT)
24300 120 IF (CJ.LT.0.0) GO TO 750
24400 CI=SQRT(CJ)
24500 GO TO 600
24600 C I - INTEGRATOR (MAXIMUM 25 ELEMENTS)
24700 130 M=MTRX5(I)
24800 DYDT(M)=CJ+P2*CK+P3*CL
24900 GO TO 650
25000 C J - JITTER (RANDOM NUMBER GENERATOR BETWEEN + AND - 1)
25100 140 IR=259*IR
25200 CI=FLOAT(IR)/131072.0
25300 GO TO 600
25400 C K - CONSTANT
25500 C L - LIMITER
25600 150 IF (CJ.LT.P1) GO TO 160
25700 CI=P1
25800 GO TO 600
25900 160 IF (CJ.GT.P2) GO TO 280
26000 170 CI=P2
26100 GO TO 600
26200 C M - MAGNITUDE
26300 180 CI=ABS(CJ)
26400 GO TO 600
26500 C N - NEGATIVE CLIPPER
26600 190 IF (CJ.GT.0.0) GO TO 280
26700 200 CI=0.0
26800 GO TO 600
26900 C O - OFFSET
27000 210 CI=CJ+P1
27100 GO TO 600
27200 C P - POSITIVE CLIPPER
27300 220 IF (CJ) 280,200,200
27400 C Q - QUIT
27500 230 IF (CJ-CK) 650,650,850
27600 C R - RELAY
27700 240 IF (CJ.LT.0.0) GO TO 260
27800 250 CI=CK
27900 GO TO 600
28000 260 CI=CL
28100 GO TO 600
28200 C S - SWITCH
28300 270 M=P1
28400 IF (RSAC(M)) GO TO 250
28500 280 CI=CJ
28600 GO TO 600
28700 C T -TIME PULSE GENERATOR
28800 290 IF (TEST5-2) 300,200,330
28900 300 MTRX5(I)=0
29000 310 IF (CJ.LT.0.0) GO TO 200
29100 MTRX5(I)=1
29200 320 PAR2(I)=-P1+DTS2+DT
29300 CI=1.0
29400 GO TO 600
29500 330 IF (MTRX5(I).EQ.0) GO TO 310
29600 IF (P2.GE.0.0) GO TO 320
29700 PAR2(I)=P2+DT
29800 GO TO 200
29900 C U - UNIT DELAY
30000 340 IF (TEST5.NE.1) C(I)=P2
30100 PAR2(I)=CJ
30200 GO TO 650
30300 C V - VACUOUS (USED IN CONJUNCTION WITH WYE ELEMENT)
30400 350 IF (TEST5.EQ.1) MTRX5(I)=NEXT
30500 GO TO 650
30600 C W - WEIGHTED SUMMER
30700 360 CI=CJ*P1+CK*P2+CL*P3
30800 GO TO 600
30900 C X - MULTIPLIER
31000 370 CI=CJ*CK
31100 GO TO 600
31200 C Y - WYE(USED IN CONJUNCTION WITH VACUOUS ELEMENT)
31300 380 IF (ABS(1.0-CK/CJ).LE.P1) GO TO 280
31400 IF (RSAC(0)) GO TO 800
31500 C(K)=(1.0-P2)*CJ+P2*CK
31600 NEXT=MTRX5(K)
31700 GO TO 20
31800 C Z - ZERO ORDER HOLD
31900 390 IF (TEST5.NE.1) GO TO 400
32000 PAR2(I)=C(I)
32100 P2=C(I)
32200 400 IF (CK.LE.0.0) GO TO 170
32300 PAR2(I)=CJ
32400 GO TO 280
32500 C + - SUMMER
32600 410 IF (J) 420,430,440
32700 420 J=-J
32800 CI=-C(J)
32900 GO TO 450
33000 430 CI=0.0
33100 GO TO 450
33200 440 CI=CJ
33300 450 IF (K) 460,480,470
33400 460 K=-K
33500 CI=CI-C(K)
33600 GO TO 480
33700 470 CI=CI+CK
33800 480 IF (L) 490,600,500
33900 490 L=-L
34000 CI=CI-C(L)
34100 GO TO 600
34200 500 CI=CI+CL
34300 GO TO 600
34400 C - - SIGN INVERTER
34500 510 CI=-CJ
34600 GO TO 600
34700 C / - DIVIDER
34800 520 IF (CK.EQ.0.0) GO TO 750
34900 CI=CJ/CK
35000 C 1 - SPECIAL ELEMENT NUMBER 1
35100 C 2 - SPECIAL ELEMENT NUMBER 2
35200 C 3 - SPECIAL ELEMENT NUMBER 3
35300 C 4 - SPECIAL ELEMENT NUMBER 4
35400 C 5 - SPECIAL ELEMENT NUMBER 5
35500 C HAVE ALL BEEN DELETED
35600 600 C(I)=CI
35700 650 IF (NEXT-NLIST) 700,900,750
35800 700 NEXT=NEXT+1
35900 GO TO 20
36000 C PROCESSING ERROR
36100 750 TEST5=4
36200 RETURN
36300 C RUN TERMINATED BY SWITCH 0
36400 800 TEST5=5
36500 RETURN
36600 C RUN TERMINATED BY QUIT ELEMENT
36700 850 TEST5=6
36800 900 RETURN
36900 END
37000 SUBROUTINE CSM13
37100 C BLOCK OUTPUT INTERROGATION
37200 DIMENSION C(75)
37300 COMMON REALS(395),INTS(547)
37400 EQUIVALENCE (REALS(2),C(1))
37500 WRITE(30,10)
37600 10 FORMAT (/10X,28H OUTPUT INTERROGATION OPTION/)
37700 20 WRITE(30,30)
37800 30 FORMAT(7H BLOCK=$)
37900 I=KINPUT(0,IERR)
38000 IF (IERR) 90,40,50
38100 40 IF (FINPUT(-1,IERR).NE.0.0) GO TO 50
38200 IF (I) 50,90,70
38300 50 WRITE(30,60)
38400 60 FORMAT(5H WHAT)
38500 GO TO 20
38600 70 IF (I.GT.75) GO TO 50
38700 WRITE(30,80) I,C(I)
38800 80 FORMAT(16H OUTPUT OF BLOCK,I3,4H IS ,G15.8)
38900 GO TO 20
39000 90 RETURN
39100 END
00100 C PLOT ROUTINE FOR H-P PLOTTER AND TEK TERMINAL
00200 C FEATURES AUTOMATIC SELECTION OF DATA
00300 C POINTS TO BE PLOTTED TO REPRODUCE THE
00400 C CURVE TO DESIRED ACCURACY.
00500 C***MODIFIED TO USE USER SUPPLIED MAX AND MIN FOR MULTIPLE PLOTS
00600 C
00700 SUBROUTINE GPLOT(V,H,N,VS,HS,IV,IH,IOPT,M,ERR,IERASE,
00800 1VMAX,VMIN,HMAX,HMIN)
00900 C
01000 C V,H LINEAR ARRAYS FOR HORIZ AND VERT DATA
01100 C N LENGTH OF V AND H
01200 C VS,HS 0. AUTO SCALING
01300 C <0. AUTO SCALING, AXIS SPAN OR # CYCLES
01400 C RETURNED IN VS AND/OR HS
01500 C >0. SCALING SPECIFIED, VS AND/OR HS ARE
01600 C EQUAL TO THE DESIRED SPAN
01700 C IV,IH 0 LINEAR
01800 C 1 LOG
01900 C 2 POLAR
02000 C IOPT IOPT=IOPT1+IOPT2+IOPT3+IOPT4
02100 C IOPT1 0 NOPLOT IOPT3 0 NO BOX
02200 C 1 PLOT DATA 100 LARGE BOX
02300 C 2 SAVE DATA 200 SMALL BOX
02400 C
02500 C IOPT2 0 NO AXES IOPT4 0 PLOT ALL
02600 C 10 AXES ONLY 1000 OMIT LAST POINT
02700 C 20 AXES+LABELS
02800 C IOPT5 0 REGULAR PLOT
02900 C 10000 FULL SCREEN PLOT
03000 C (TEK ONLY)
03100 C M 0 LINES
03200 C 1-6 SYMBOLS
03300 C 'L' WHERE L IS ANY CHARACTER TO BE PLOTTED
03400 C AT THE DATA POINTS
03500 C ERR ERROR (FINE=5.,MEDIUM=20.,COARSE=50.)
03600 C IERASE 0 OVERPLOT
03700 C 1 ERASE
03800 C
03900 DIMENSION V(1),H(1),ST(2)
04000 LOGICAL PLTDATA,LASTPT,BOX,AXES,LABELS,ERASE,SBOX,BIGPLOT,SAVE
04100 C
04200 2 FORMAT(' PLTL')
04300 3 FORMAT(' PLTT'/)
04400 4 FORMAT(1X,I4,1X,I4)
04500 5 FORMAT(' X AXIS SCALE IS',G,'PER DIVISION')
04600 6 FORMAT(' Y AXIS SCALE IS',G,'PER DIVISION')
04700 7 FORMAT(1X,I4,1X,I4,'^')
04800 8 FORMAT(' X AXIS LOG ORIGIN AT',G)
04900 9 FORMAT(' Y AXIS LOG ORIGIN AT',G)
05000 10 FORMAT(' CAN''T GRAPH NEGATIVES OR ZERO ON LOG SCALE')
05100 11 FORMAT(7X,'NUMBER OF CYCLES IS',I2)
05200 12 FORMAT(' X AXIS MINIMUM IS',G)
05300 13 FORMAT(' Y AXIS MINIMUM IS',G/)
05400 14 FORMAT('0IMPROPER VALUE FOR GPLOT SUBROUTINE ARGUMENT!!'//)
05500 15 FORMAT(G10.4)
05600 16 FORMAT(I3)
05700 17 FORMAT('0VERTICAL DATA RANGE TOO SMALL !! '//)
05800 18 FORMAT('0HORIZONTAL DATA RANGE TOO SMALL !! '//)
05900 C
06000 C CHECK ARGUMENTS
06100 C
06200 20 IF(N.LE.0)GO TO 90
06300 IF(((IV/3).NE.0).OR.((IH/3).NE.0))GO TO 90
06400 IF(IV.EQ.2)IH=2
06500 IF(IH.EQ.2)IV=2
06600 BIGPLOT=.FALSE.
06700 SAVE=.FALSE.
06800 LASTPT=.TRUE.
06900 ERASE=.TRUE.
07000 BOX=.TRUE.
07100 SBOX=.TRUE.
07200 AXES=.TRUE.
07300 PLTDATA=.TRUE.
07400 LABELS=.TRUE.
07500 IX=MOD(IOPT,10)
07600 IF(IX.EQ.0)PLTDATA=.FALSE.
07700 IF(IX.EQ.2)SAVE=.TRUE.
07800 IX=MOD(IOPT/10,10)
07900 IF(IX.LT.2)LABELS=.FALSE.
08000 IF(IX.LT.1)AXES=.FALSE.
08100 IX=MOD(IOPT/100,10)
08200 IF(IX.LT.2)SBOX=.FALSE.
08300 IF(IX.LT.1)BOX=.FALSE.
08400 IX=MOD(IOPT/1000,10)
08500 IF(IX.EQ.1)LASTPT=.FALSE.
08600 IX=MOD(IOPT/10000,10)
08700 IF(IX.EQ.1)BIGPLOT=.TRUE.
08800 IF(IERASE.EQ.0)ERASE=.FALSE.
08900 IF(.NOT.PLTDATA.AND.(IOPT.NE.0))GOTO 1040
09000 C
09100 IF(VMAX.NE.VMIN)GO TO 9123
09200 CALL MINIMU(V,N,VMIN)
09300 CALL MAXIMU(V,N,VMAX)
09400 9123 IF(HMAX.NE.HMIN)GO TO 9124
09500 CALL MINIMU(H,N,HMIN)
09600 CALL MAXIMU(H,N,HMAX)
09700 9124 CALL PLOTTER(TYPE,ITYPE)
09800 IF(SAVE)CALL SAVSET(1)
09900 25 IF(VS.LE.0.)GO TO 100
10000 C
10100 C V SCALING SPECIFIED
10200 C
10300 30 VSPAN=VS
10400 VSCALE=VSPAN/10.
10500 IF(IV-1)50,35,50
10600 35 NVCYCL=VS
10700 VSCALE=7999./VS
10800 GOTO 300
10900 50 IF(HS.LE.0.)GO TO 200
11000 C
11100 C H SCALING SPECIFIED
11200 C
11300 60 HSPAN=HS
11400 HSCALE=HSPAN/15.
11500 IF(IH-1)1000,70,80
11600 70 NHCYCL=HS
11700 HSCALE=7999./HS
11800 GOTO 400
11900 80 SPAN=HS
12000 GOTO 260
12100 C
12200 C POLAR AUTO SCALING
12300 C
12400 240 IND=1
12500 SPAN=VSPAN
12600 SCALE=VSCALE
12700 GO TO 180
12800 260 IND=0
12900 VSPAN=AMAX1(SPAN,VSPAN)
13000 VSCALE=VSPAN/10.
13100 HSPAN=VSPAN*1.5
13200 HSCALE=VSCALE
13300 GO TO 1000
13400 C
13500 C ERROR RETURN
13600 C
13700 90 TYPE 14
13800 RETURN
13900 92 TYPE 17
14000 RETURN
14100 94 TYPE 18
14200 RETURN
14300 C
14400 C LINEAR AUTO SCALING
14500 C
14600 100 IF(IV.EQ.1)GO TO 300
14700 RANGE=VMAX-VMIN
14800 IF(RANGE.LT.1.E-35)GOTO 92
14900 IND=0
15000 IF(IV.EQ.0)GO TO 160
15100 RANGE=2.*AMAX1(VMAX,ABS(VMIN))
15200 160 NN=INT(ALOG10(RANGE))
15300 IF(RANGE.LT.1.)NN=NN-1
15400 P=10.**NN
15500 R = RANGE / P
15600 180 VSPAN=10.*P
15700 IF(R.LE.7.51)VSPAN=7.5*P
15800 IF(R.LE.5.01)VSPAN=5.*P
15900 IF(R.LE.2.51)VSPAN=2.5*P
16000 IF(R.LE.2.01)VSPAN=2.*P
16100 IF(R.LE.1.01)VSPAN=P
16200 VSCALE=VSPAN/10.
16300 IF(IND.EQ.1)GO TO 260
16400 GO TO 50
16500 200 IF(IH.EQ.1)GO TO 400
16600 RANGE=HMAX-HMIN
16700 IF(RANGE.LT.1.E-35)GOTO 94
16800 IF(IH.EQ.0)GO TO 220
16900 RANGE=2.*AMAX1(HMAX,ABS(HMIN))
17000 220 NN=INT(ALOG10(RANGE))
17100 IF(RANGE.LT.1.)NN=NN-1
17200 P=10.**NN
17300 R=RANGE/P
17400 IF(IH.EQ.2)GO TO 240
17500 HSPAN=10.*P
17600 IF(R.LE.7.51)HSPAN=7.5*P
17700 IF(R.LE.5.01)HSPAN=5.*P
17800 IF(R.LE.3.76)HSPAN=3.75*P
17900 IF(R.LE.3.01)HSPAN=3.*P
18000 IF(R.LE.1.51)HSPAN=1.5*P
18100 HSCALE=HSPAN/15.
18200 GO TO 1000
18300 C
18400 C AUTO SCALING - LOG
18500 C
18600 300 IF((VMAX.GT.0.).AND.(VMIN.LE.0.))GO TO 390
18700 TT=ALOG10(ABS(VMIN))
18800 NVMIN=INT(TT+((SIGN(1.002,TT)-1.)/2.))
18900 IF(VS.GT.0.)GOTO 50
19000 TT=ALOG10(ABS(VMAX))
19100 NVMAX=INT(TT+((SIGN(.998,TT)+1.)/2.))
19200 NVCYCL=IABS(NVMAX-NVMIN)
19300 VSCALE=7999./NVCYCL
19400 GO TO 50
19500 390 TYPE 10
19600 RETURN
19700 400 IF((HMAX.GT.0.).AND.(HMIN.LE.0.))GO TO 390
19800 TT=ALOG10(ABS(HMIN))
19900 NHMIN=INT(TT+((SIGN(1.002,TT)-1.)/2.))
20000 IF(HS.GT.0.)GOTO 1000
20100 TT=ALOG10(ABS(HMAX))
20200 NHMAX=INT(TT+((SIGN(.998,TT)+1.)/2.))
20300 NHCYCL=IABS(NHMAX-NHMIN)
20400 HSCALE=7999./NHCYCL
20500 GO TO 1000
20600 C
20700 C SET PLOT WINDOWS
20800 C
20900 1000 IF(ITYPE.NE.2)GO TO 1002
21000 IF(.NOT.ERASE)GO TO 990
21100 CALL NEWPAG
21200 990 IF(IH.EQ.2)GO TO 1003
21300 CALL VWINDO(0.,9999.,0.,9999.)
21400 CALL SWINDO(100,900,50,600)
21500 IF(BIGPLOT)CALL SWINDO(0,1000,50,666)
21600 GO TO 1002
21700 1003 CALL VWINDO(0.,7333.,0.,9999.)
21800 CALL SWINDO(250,770,50,700)
21900 IF(BIGPLOT)CALL SWINDO(140,858,0,780)
22000 C
22100 C SAVE DATA
22200 C
22300 1002 IF(.NOT.PLTDATA)GOTO 1004
22400 HHMIN=10.**NHMIN
22500 VVMIN=10.**NVMIN
22600 CALL CHGDEV('DSK14',4)
22700 CALL DEFINE FILE(4,0,NR,'DATA.TMP',0,0)
22800 WRITE(4)(H(I),I=1,N)
22900 WRITE(4)(V(I),I=1,N)
23000 END FILE (4)
23100 IF(ITYPE.NE.2)TYPE 2
23200 C
23300 C SCALE DATA
23400 C
23500 1004 VSHIFT=0.
23600 HSHIFT=0.
23700 IF(IV.EQ.0)VSHIFT=AMOD(VMIN,VSCALE)
23800 IF(IH.EQ.0)HSHIFT=AMOD(HMIN,HSCALE)
23900 VSHIFT=VSHIFT+VSCALE*(.5-SIGN(.5,VSHIFT))
24000 HSHIFT=HSHIFT+HSCALE*(.5-SIGN(.5,HSHIFT))
24100 IF(.NOT.PLTDATA)GOTO 692
24200 1005 DO 1007 I=1,N
24300 IF(IV.EQ.0)V(I)=((V(I)-VMIN+VSHIFT)*7999./VSPAN)
24400 IF(IV.EQ.1)V(I)=(VSCALE*ALOG10(ABS(V(I)/VVMIN)))
24500 IF(IV.EQ.2)V(I)=V(I)*7999./VSPAN+3999.
24600 V(I)=V(I)+999.
24700 C
24800 IF(IH.EQ.0)H(I)=((H(I)-HMIN+HSHIFT)*7999./HSPAN)
24900 IF(IH.EQ.1)H(I)=(HSCALE*ALOG10(ABS(H(I)/HHMIN)))
25000 IF(IH.EQ.2)H(I)=H(I)*7999./HSPAN+2666.
25100 H(I)=H(I)+1333.
25200 1007 CONTINUE
25300 C
25400 IF(M.EQ.0)GO TO 600
25500 C
25600 C PLOT SYMBOLS
25700 C
25800 DO 1009 I=1,N
25900 JX=H(I)
26000 JY=V(I)
26100 IF((I.EQ.N).AND..NOT.LASTPT)GOTO 690
26200 CALL SYMPLT(JX,JY,M,1.,ITYPE)
26300 1009 CONTINUE
26400 GO TO 690
26500 C
26600 C PLOT FIRST POINT
26700 C
26800 600 JX=H(1)
26900 JY=V(1)
27000 JXL=JX
27100 JYL=JY
27200 IS=3
27300 CALL PLOUT(JX,JY,ITYPE,1)
27400 C
27500 C PLOT THIS POINT?
27600 C
27700 610 IF(IS.GT.N)GO TO 655
27800 DO 650 I=IS,N
27900 SLOPE=(V(I)-JYL)/(H(I)-JXL)
28000 ASLOPE=ABS(SLOPE)
28100 IF=I-1
28200 DO 630 J=IS-1,IF
28300 IF(ASLOPE.LE.1.)DERR=ABS(V(J)-SLOPE*(H(J)-JXL)-JYL)
28400 IF(ASLOPE.GT.1.)DERR=ABS(H(J)-(V(J)-JYL)/SLOPE-JXL)
28500 IF(DERR.GE.ERR)GO TO 660
28600 IF((IF-IS).GT.50)GO TO 660
28700 630 CONTINUE
28800 650 CONTINUE
28900 C
29000 C FINISH
29100 C
29200 655 IF(.NOT.LASTPT)GOTO 690
29300 JX=H(N)
29400 JY=V(N)
29500 CALL PLOUT(JX,JY,ITYPE,3)
29600 GOTO 690
29700 C
29800 C SET-UP POINT TO BE PLOTTED
29900 C
30000 660 JX=H(I-1)
30100 JY=V(I-1)
30200 IS=I+1
30300 GO TO 1006
30400 C
30500 C RESTORE DATA
30600 C
30700 690 CALL DEFINE FILE(4,0,NR,'DATA.TMP',0,0)
30800 READ(4)(H(I),I=1,N)
30900 READ(4)(V(I),I=1,N)
31000 CALL RELEAS(4)
31100 CALL DELETE('DATA.TMP')
31200 CALL RSTDEV
31300 692 IF(VS.GE.0.)GOTO 695
31400 VS=VSPAN
31500 IF(IV.EQ.1)VS=NVCYCL
31600 695 IF(HS.GE.0.)GOTO 1010
31700 HS=HSPAN
31800 IF(IH.EQ.1)HS=NHCYCL
31900 GO TO 1010
32000 C
32100 C CHECK LENGTH OF LINE AND PLOT
32200 C
32300 1006 VECT=0.
32400 IF(ITYPE.EQ.1)
32500 1 VECT=SQRT((15.*(JX-JXL)/7999.)**2.+(10.*(JY-JYL)/7999.)**2.)
32600 NDIV=(VECT/3.01+1.0)
32700 JXD=(JX-JXL)/NDIV
32800 JYD=(JY-JYL)/NDIV
32900 DO 1008 IC=1,NDIV
33000 JXL=JXL+JXD
33100 JYL=JYL+JYD
33200 CALL PLOUT(JXL,JYL,ITYPE,3)
33300 1008 CONTINUE
33400 GO TO 610
33500 C
33600 C OUTPUT SCALE INFO
33700 C
33800 1010 HMINSH=HMIN-HSHIFT
33900 VMINSH=VMIN-VSHIFT
34000 IF(IV.NE.2)GOTO 1015
34100 HMINSH=-5.*HSCALE
34200 VMINSH=HMINSH
34300 1015 IF(ITYPE.EQ.2)GO TO 1040
34400 TYPE 3
34500 IF(IH.EQ.1)GO TO 1050
34600 1020 TYPE 5,HSCALE
34700 IF(IV.EQ.1)GO TO 1060
34800 1030 TYPE 6,VSCALE
34900 1035 TYPE 12,HMINSH
35000 TYPE 13,VMINSH
35100 1040 IF(AXES)GOTO 2000
35200 IF(BOX)GOTO 3000
35300 1045 IF(ITYPE.EQ.2)GO TO 2500
35400 GOTO9000
35500 1050 TYPE 8,HHMIN
35600 TYPE 11,NHCYCL
35700 IF(IV.NE.1)GO TO 1030
35800 1060 TYPE 9,VVMIN
35900 TYPE 11,NVCYCL
36000 GO TO 1035
36100 C
36200 C HORIZONTAL AXIS PRINT-OUT
36300 C
36400 2000 NDIV=1
36500 IF(ITYPE.EQ.1)NDIV=4
36600 JX=1333
36700 IF(IV.NE.1)JY=(-VMIN+VSHIFT)*7999./VSPAN+999
36800 IF(JY.LT.999)JY=999
36900 IF(JY.GT.8999)JY=8999
37000 IF(IV.EQ.1)JY=999
37100 IF(IH.EQ.2)JY=4999
37200 IF(ITYPE.EQ.1)TYPE 2
37300 CALL PLOUT(JX,JY,ITYPE,1)
37400 INC=8000/NDIV
37500 IF(IH.EQ.2)INC=5333/NDIV
37600 DO 2010 I=1,NDIV
37700 JX=JX+INC
37800 2010 CALL PLOUT(JX,JY,ITYPE,3)
37900 JYZ=JY+125
38000 JYZZ=JY-125
38100 JXST=1333
38200 JXFIN=JX
38300 JYZERO=JY
38400 JX=1333
38500 IF(IH.EQ.1)GOTO 2100
38600 C
38700 C LINEAR HORIZONTAL TICS
38800 C
38900 DO 2020 I=1,16
39000 CALL PLOUT(JX,JYZ,ITYPE,1)
39100 CALL PLOUT(JX,JYZZ,ITYPE,3)
39200 JX=JX+533
39300 IF((I.GT.10).AND.(IH.EQ.2))GOTO 2030
39400 2020 CONTINUE
39500 2030 JX=JX-266
39600 2035 CALL PLOUT(JX+60,JYZ,ITYPE,1)
39700 CALL PLOUT(JX-60,JYZZ,ITYPE,3)
39800 CALL PLOUT(JX-60,JYZ,ITYPE,1)
39900 CALL PLOUT(JX+60,JYZZ,ITYPE,3)
40000 C
40100 C VERTICAL AXIS PRINT-OUT
40200 C
40300 2050 JY=999
40400 IF(IH.NE.1)JX=(-HMIN+HSHIFT)*7999./HSPAN+1333
40500 IF(JX.LT.1333)JX=1333
40600 IF(JX.GT.9333.)JX=9333
40700 IF(IH.EQ.1)JX=1333
40800 IF(IV.EQ.2)JX=3999
40900 CALL PLOUT(JX,JY,ITYPE,1)
41000 NDIV=1
41100 IF(ITYPE.EQ.1)NDIV=4
41200 INC=8000/NDIV
41300 DO 2060 I=1,NDIV
41400 JY=JY+INC
41500 2060 CALL PLOUT(JX,JY,ITYPE,3)
41600 JYST=999
41700 JYFIN=8999
41800 JXZERO=JX
41900 JY=999
42000 JXZ=JX+90
42100 JXZZ=JX-90
42200 IF(IV.EQ.1)GOTO 2300
42300 C
42400 C LINEAR VERTICAL TICS
42500 C
42600 DO 2080 I=1,11
42700 CALL PLOUT(JXZ,JY,ITYPE,1)
42800 CALL PLOUT(JXZZ,JY,ITYPE,3)
42900 2080 JY=JY+800
43000 JY=JY-400
43100 2085 CALL PLOUT(JX-60,JY+125,ITYPE,1)
43200 CALL PLOUT(JX,JY,ITYPE,3)
43300 CALL PLOUT(JX+60,JY+125,ITYPE,1)
43400 CALL PLOUT(JX,JY,ITYPE,3)
43500 CALL PLOUT(JX,JY-125,ITYPE,3)
43600 GOTO 2450
43700 C
43800 C LOG HORIZONTAL TICS
43900 C
44000 2100 NC=NHCYCL
44100 JYQ=JY+250
44200 JYQQ=JY-250
44300 IT=(NC+4)/5
44400 IF(IT.LE.3)GOTO 2110
44500 NC=2-(NC-(NC/2)*2)
44600 2110 NSEG=7999/NC
44700 SEG=FLOAT(NSEG)
44800 DO 2140 I=1,NC
44900 CALL PLOUT(JX,JYQ,ITYPE,1)
45000 CALL PLOUT(JX,JYQQ,ITYPE,3)
45100 IF(IT.GT.3)GOTO 2130
45200 DO 2120 J=2,10-IT,IT
45300 JXP=JX+INT(SEG*ALOG10(FLOAT(J)))
45400 CALL PLOUT(JXP,JYZ,ITYPE,1)
45500 CALL PLOUT(JXP,JYZZ,ITYPE,3)
45600 2120 CONTINUE
45700 2130 JX=JX+NSEG
45800 2140 CONTINUE
45900 CALL PLOUT(JX,JYQ,ITYPE,1)
46000 CALL PLOUT(JX,JYQQ,ITYPE,3)
46100 JX=JX+266
46200 GOTO 2035
46300 C
46400 C LOG VERTICAL TICS
46500 C
46600 2300 NC=NVCYCL
46700 JXQ=JX+180
46800 JXQQ=JX-180
46900 IT=(NC+4)/5
47000 IF(IT.LE.2)GOTO 2310
47100 NC=2-(NC-(NC/2)*2)
47200 2310 NSEG=7999/NC
47300 SEG=(FLOAT(NSEG))
47400 DO 2340 I=1,NC
47500 CALL PLOUT(JXQ,JY,ITYPE,1)
47600 CALL PLOUT(JXQQ,JY,ITYPE,3)
47700 IF(IT.GT.2)GOTO 2330
47800 DO 2320 J=2,10-IT,IT
47900 JYP=JY+INT(SEG*ALOG10(FLOAT(J)))
48000 CALL PLOUT(JXZ,JYP,ITYPE,1)
48100 CALL PLOUT(JXZZ,JYP,ITYPE,3)
48200 2320 CONTINUE
48300 2330 JY=JY+NSEG
48400 2340 CONTINUE
48500 CALL PLOUT(JXQ,JY,ITYPE,1)
48600 CALL PLOUT(JXQQ,JY,ITYPE,3)
48700 JY=JY+400
48800 GOTO 2085
48900 2450 IF(LABELS)GOTO 2600
49000 IF(BOX)GOTO 3000
49100 IF(ITYPE.EQ.2)GO TO 2500
49200 2460 TYPE 3
49300 GOTO9000
49400 2500 CALL HOME
49500 CALL ANMODE
49600 GOTO9000
49700 C
49800 C LABEL AXES
49900 C
50000 2600 IF(.NOT.SAVE)GOTO2605
50100 IF(BOX)GOTO3000
50200 GOTO9000
50300 2605 IF(ITYPE.EQ.1)GOTO 2700
50400 C
50500 C LABELS FOR TEK TERMINAL
50600 C
50700 C X AXIS LABELS
50800 C
50900 IF(IH.EQ.1)GOTO 2610
51000 CALL PLOUT(JXST-266,JYZERO-600,ITYPE,1)
51100 CALL ANMODE
51200 CALL LOUT(HMINSH,6,3,0)
51300 CALL PLOUT(JXFIN-266,JYZERO-600,ITYPE,1)
51400 CALL ANMODE
51500 Q=HMINSH+HSCALE*(15-5*IH/2)
51600 CALL LOUT(Q,6,3,0)
51700 GO TO 2650
51800 2610 CALL PLOUT(JXST,JYZERO-800,ITYPE,1)
51900 CALL BAKSP
52000 CALL BAKSP
52100 CALL LOUT(10,0)
52200 CALL TOUTPT(11)
52300 CALL LOUT(NHMIN,0)
52400 CALL PLOUT(JXFIN,JYZERO-800,ITYPE,1)
52500 CALL BAKSP
52600 CALL BAKSP
52700 CALL LOUT(10,0)
52800 CALL TOUTPT(11)
52900 NQ=NHMIN+NHCYCL
53000 CALL LOUT(NQ,0)
53100 C
53200 C Y AXIS LABELS
53300 C
53400 2650 IF(IV.EQ.1)GOTO 2660
53500 CALL PLOUT(JXZERO-1333,JYST+200,ITYPE,1)
53600 CALL ANMODE
53700 CALL LOUT(VMINSH,6,3,0)
53800 CALL PLOUT(JXZERO-1333,JYFIN-400,ITYPE,1)
53900 CALL ANMODE
54000 Q=VMINSH+VSCALE*10.
54100 CALL LOUT(Q,6,3,0)
54200 IF(BOX)GOTO 3000
54300 GOTO 2500
54400 2660 CALL PLOUT(JXZERO-666,JYST,ITYPE,1)
54500 CALL BAKSP
54600 CALL BAKSP
54700 CALL LOUT(10,0)
54800 CALL TOUTPT(11)
54900 CALL LOUT(NVMIN,0)
55000 CALL PLOUT(JXZERO-666,JYFIN-600,ITYPE,1)
55100 CALL BAKSP
55200 CALL BAKSP
55300 CALL LOUT(10,0)
55400 CALL TOUTPT(11)
55500 NQ=NVMIN+NVCYCL
55600 CALL LOUT(NQ,0)
55700 IF(BOX)GOTO 3000
55800 GOTO 2500
55900 C
56000 C LABELS FOR HP PLOTTER
56100 C
56200 C X AXIS LABELS
56300 C
56400 2700 IF(IH.EQ.1)GOTO 2720
56500 ENCODE(10,15,ST)HMINSH
56600 CALL TITLE(ST,2,JXST-600,JYZERO-400,2.,0.)
56700 Q=HMINSH+HSCALE*(15-5*IH/2)
56800 ENCODE(10,15,ST)Q
56900 CALL TITLE(ST,2,JXFIN-600,JYZERO-400,2.,0.)
57000 GOTO 2750
57100 2720 CALL TITLE(' 10',1,JXST-600,JYZERO-400,2.,0.)
57200 ENCODE(5,16,ST)NHMIN
57300 CALL LJUST(ST,1)
57400 CALL TITLE(ST,1,JXST,JYZERO-300,2.,0.)
57500 CALL TITLE(' 10',1,JXFIN-600,JYZERO-400,2.,0.)
57600 NQ=NHMIN+NHCYCL
57700 ENCODE(5,16,ST)NQ
57800 CALL LJUST(ST,1)
57900 CALL TITLE(ST,1,JXFIN,JYZERO-300,2.,0.)
58000 C
58100 C Y AXIS LABELS
58200 C
58300 2750 IF(IV.EQ.1)GOTO 2770
58400 ENCODE(10,15,ST)VMINSH
58500 CALL TITLE(ST,2,JXZERO-1333,JYST+100,2.,0.)
58600 Q=VMINSH+VSCALE*10.
58700 ENCODE(10,15,ST)Q
58800 CALL TITLE(ST,2,JXZERO-1333,JYFIN-200,2.,0.)
58900 IF(BOX)GOTO 3000
59000 GOTO 2460
59100 2770 CALL TITLE(' 10',1,JXST-960,JYST,2.,0.)
59200 ENCODE(5,16,ST)NVMIN
59300 CALL LJUST(ST,1)
59400 CALL TITLE(ST,1,JXST-360,JYST+100,2.,0.)
59500 CALL TITLE(' 10',1,JXST-960,JYFIN-200,2.,0.)
59600 NQ=NVMIN+NVCYCL
59700 ENCODE(5,16,ST)NQ
59800 CALL LJUST(ST,1)
59900 CALL TITLE(ST,1,JXST-360,JYFIN-100,2.,0.)
60000 IF(BOX)GOTO 3000
60100 GOTO 2460
60200 C
60300 C DRAW BOX
60400 C
60500 3000 IF(SBOX)GOTO 3040
60600 JXST=0
60700 JXFIN=9999
60800 IF(IH.EQ.2)JXFIN=7333
60900 JYST=0
61000 JYFIN=9999
61100 GOTO 3050
61200 3040 JXST=1333
61300 JYST=999
61400 JXFIN=9333
61500 IF(IH.EQ.2)JXFIN=6666
61600 JYFIN=8999
61700 3050 CALL PLOUT(JXST,JYST,ITYPE,1)
61800 INCX=(JXFIN-JXST)/NDIV
61900 INCY=(JYFIN-JYST)/NDIV
62000 JX=JXST
62100 JY=JYST
62200 DO 3060 I=1,NDIV
62300 JX=JX+INCX
62400 3060 CALL PLOUT(JX,JY,ITYPE,3)
62500 DO 3070 I=1,NDIV
62600 JY=JY+INCY
62700 3070 CALL PLOUT(JX,JY,ITYPE,3)
62800 DO 3080 I=1,NDIV
62900 JX=JX-INCX
63000 3080 CALL PLOUT(JX,JY,ITYPE,3)
63100 DO 3090 I=1,NDIV
63200 JY=JY-INCY
63300 3090 CALL PLOUT(JX,JY,ITYPE,3)
63400 IF(ITYPE.EQ.1)GOTO 2460
63500 GOTO 2500
63600 9000 IF(SAVE)CALL SAVSET(-1)
63700 RETURN
63800 END
63900 C
64000 C AUXILLARY SUBROUTINE
64100 C
64200 SUBROUTINE LJUST(ST,N)
64300 C
64400 C ST ASCII STRING
64500 C N LENGTH OF ST
64600 C
64700 C ROUTINE LEFT-JUSTIFIES CONTENTS OF ST
64800 C
64900 DIMENSION ST(1)
65000 C
65100 NUM=5*N
65200 DO 10 I=1,NUM
65300 CALL GETCHR(ST,I,CHR)
65400 IF(CHR.NE.' ')GOTO 20
65500 10 CONTINUE
65600 RETURN
65700 20 IF(I.EQ.1)RETURN
65800 DO 30 J=I,NUM
65900 CALL GETCHR(ST,J,CHR)
66000 30 CALL PUTCHR(ST,J-I+1,CHR)
66100 DO 40 J=NUM-I+2,NUM
66200 40 CALL PUTCHR(ST,J,' ')
66300 RETURN
66400 END