Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0113/cmod42.bas
There are 2 other files named cmod42.bas in the archive. Click here to see a list.
00050  DIM X(1000)              ,E(12)
00051DIMG(16,51)
00060FILES RFILE1,RFILE2,RFILE3,RF4, , RF6,RF7, ,RF9
00100RESTORE#1
00101  INPUT#  1,I1,I2,I3
00110SCRATCH#1
00111  PRINT #  1,45,I2,I3
00120REM  *************************************************************
00130REM    CMOD42    CMOD42    CMOD42    CMOD42    CMOD42    CMOD42
00140REM **************************************************************
00150GOSUB 8500
00160S0=0
00170K0=1
00180  A$="o"
00190S0=1
00200PRINT L$
00210PRINT "            BIVARIATE  PLOTS"
00220PRINT
00230PRINT "THE VERTICAL AXIS IS DIVIDED INTO 15 EQUALLY SPACED INTERVALS"
00240PRINT "THE HORIZONTAL AXIS IS DIVIDED INTO 50.  THERE IS A TICK MARK"
00250PRINT "AT EVERY 5TH INTERVAL."
00260GOSUB 1500
00270PRINT
00280PRINT "INPUT THE NUMBER OF THE VARIABLE YOU WANT PLOTTED ON THE"
00290PRINT "VERTICAL AXIS (EXIT=0).";
00300GOSUB 9000
00310IF O1 <> 0 THEN 330
00320CHAIN "CMOD14"
00330IF O1 <= V0 THEN 360
00340PRINT "REENTER.  INPUT MUST BE NUMBER OF VARIABLE."
00350GOTO 300
00360IF O1<1 THEN 340
00370GOSUB 2530
00380IF Z0=0 THEN 300
00390K6=O1
00400K8=K6
00410GOSUB 1400
00420PRINT
00430PRINT "INPUT THE NUMBER OF THE VARIABLE YOU WANT PLOTTED ON THE"
00440PRINT "HORIZONTAL AXIS.";
00450GOSUB 9000
00460IF O1 <= V0 THEN 490
00470PRINT "REENTER.  INPUT MUST BE NUMBER OF VARIABLE."
00480GOTO 450
00490IF O1<1 THEN 470
00500GOSUB 2530
00510IF Z0=0 THEN 450
00520K7=O1
00530MAT G=ZER
00540I5=3
00550GOSUB 1630
00560X1=X1-.1*(X2-X1)
00570X2=X2+.1*(X2-X1)
00580S6=(X2-X1)/15
00590L6=X1
00600I5=5
00610K8=K7
00620GOSUB 1400
00630GOSUB 1630
00640X1=X1-.1*(X2-X1)
00650X2=X2+.1*(X2-X1)
00660S7=(X2-X1)/50
00670L7=X1
00680FOR K5=1 TO N0
00690I1=INT((X(K5+K6*N0-N0)-L6)/S6)+1
00700I2=INT((X(K5+K7*N0-N0)-L7)/S7)+1
00710IF I1<16 THEN 730
00720I1=16
00730IF I2<51 THEN 750
00740I2=51
00750G(I1,I2)=G(I1,I2)+1
00760NEXT K5
00770PRINT L$
00780V6=K6
00790:"  'LLLLL-+----------------------'LLLLL----------" 
00792SCRATCH#9
00795O1=V6*6-5
00796O2=K7*6-5
00800  PRINT#9USING 790,MID$(V$,O1,V6*6-(O1)+1),MID$(V$,O2,K7*6-(O2)+1) 
00811RESTORE#9
00812INPUT#9,D1$
00813PRINTD1$;
00814PRINT"----------"
00830 REM
00840S4=1
00850IF ABS(L6)>1.E+06 THEN 890
00860IF ABS(L6+50*S6)>1.E+06 THEN 890
00870IF ABS(L6+50*S6)<1 THEN 890
00880GOTO 900
00890S4=2
00900FOR K5=15 TO 0 STEP -1
00910IF K5/5 <> INT(K5/5) THEN 1000
00920Q5=L6+K5*S6
00930  ONS4  GOTO 970,950
00940:"##.#^^^^ +"
00942SCRATCH#9
00950PRINT#9USING 940,Q5 
00951RESTORE#9
00952INPUT#9,D1$
00953PRINTD1$;
00960GOTO 1020
00970:"######.# +"
00975SCRATCH#9
00980PRINT#9USING 970,Q5 
00982RESTORE#9
00983INPUT#9,D1$
00984PRINTD1$;
00990GOTO 1020
01000PRINT "         I";
01020FOR K6=1 TO 51
01030IF G(K5+1,K6)=0 THEN 1110
01040IF G(K5+1,K6)>10 THEN 1080
01050:"##"
01052SCRATCH#9
01060PRINT#9USING 1050,G(K5+1,K6)-10*INT(G(K5+1,K6)/10) 
01062RESTORE#9
01064INPUT#9,D1$
01065PRINTD1$;
01070GOTO 1130
01080REM
01090PRINT "*";
01100GOTO 1130
01110REM
01120PRINT " ";
01130NEXT K6
01140PRINT
01150NEXT K5
01160PRINT "---------+---------+---------+---------+---------+---------+"
01180S6=S7*10
01190S4=1
01200PRINT " ";
01210IF ABS(L7)>10000 THEN 1250
01220IF ABS(L7+4*S6)>10000 THEN 1250
01230IF ABS(L7+4*S6)<1 THEN 1250
01240GOTO 1260
01250S4=2
01260FOR K5=0 TO 5
01270  ONS4  GOTO 1280,1320 
01280:"######.## "
01283SCRATCH#9
01300PRINT#9USING1280,L7+K5*S6
01302RESTORE#9
01303 INPUT#9,D1$
01305PRINTD1$;
01310GOTO 1340
01320:" ##.#^^^^ "
01325SCRATCH #9
01330PRINT#9USING 1320,L7+K5*S6 
01332RESTORE#9
01334INPUT#9,D1$
01336PRINTD1$;
01340NEXT K5
01350PRINT
01360PRINT "*  MORE THAN 10                     CONTINUE=1  ";
01370GOSUB 9000
01380PRINT L$
01390GOTO 200
01400X2=-1.E+35
01410X1=1.E+35
01420FOR K5=1 TO N0
01430I3=K5+K8*N0-N0
01440IF X(I3)<X2 THEN 1460
01450X2=X(I3)
01460IF X(I3)>X1 THEN 1480
01470X1=X(I3)
01480NEXT K5
01490RETURN
01500PRINT
01510IF G6=0 THEN 1540
01520  PRINT "DATA SET = ";M$;"    GROUP= ";MID$(G$,J6*6-5,J6*6-(J6*6-5)+1)
01530GOTO 1550
01540PRINT "DATA SET = ";M$
01550PRINT "VARIABLES:"
01560FOR K5=1 TO V0
01570REM
01580  PRINT K5;" = ";MID$(V$,K5*6-5,K5*6-(K5*6-5)+1)
01590NEXT K5
01600PRINT
01610RETURN
01620M(K5)=M(K5)/N0
01630REM
01640REM
01650IF ABS(X2) >= ABS(X1) THEN 1680
01660X0=ABS(X1)
01670GOTO 1690
01680X0=ABS(X2)
01690GOSUB 2430
01700IF X0 >= 1 THEN 1710
01710K5=INT(K5)
01720IF INT(X1/10**K5) <> INT(X2/10**K5) THEN 1750
01730K5=K5-1
01740GOTO 1720
01750D1=INT(X2/10**K5)
01760D2=X2-(10**K5)*INT(X2/(10**K5))
01770D2=INT(D2/(10**(K5-1)))
01780IF X2=D1*10**K5+D2*10**(K5-1) THEN 1820
01790D2=D2+1
01800IF D2 <> 0 THEN 1820
01810D1=D1+1
01820IF D2=0 THEN 1890
01830IF D2=5 THEN 1890
01840IF D2<5 THEN 1880
01850D2=0
01860D1=D1+1
01870GOTO 1890
01880D2=5
01890U7=D1*10**K5+D2*10**(K5-1)
01900D1=INT(X1/(10**K5))
01910D2=X1-(10**K5)*INT(X1/(10**K5))
01920D2=INT(D2/(10**(K5-1)))
01930IF D2=5 THEN 1990
01940IF D2=0 THEN 1990
01950IF D2<5 THEN 1980
01960D2=5
01970GOTO 1990
01980D2=0
01990L7=D1*10**K5+D2*10**(K5-1)
02000D5=(U7-L7)/I5
02010GOTO 2040
02020K5=LOG(D5)/LOG(10)
02030K5=INT(K5)
02040D1=INT(D5/(10**K5))
02050D2=D5-(10**K5)*INT(D5/(10**K5))
02060D2=INT(D2/(10**(K5-1)))
02070IF D1 <> 0 THEN 2100
02080IF D2 <> 0 THEN 2100
02090GOTO 2020
02100IF D5=D1*10**K5+D2*10**(K5-1) THEN 2140
02110D2=D2+1
02120IF D2 <> 0 THEN 2140
02130D1=D1+1
02140IF D2=5 THEN 2210
02150IF D2=0 THEN 2210
02160IF D2<5 THEN 2200
02170D2=0
02180D1=1
02190GOTO 2210
02200D2=5
02210D5=D1*10**K5+D2*10**(K5-1)
02220I2=D5
02230RETURN
02240X0=ABS(X2)
02250GOSUB 2430
02260IF X1 >= 0 THEN 2300
02270I=X2-(INT(X1/10**(K5-1))-1)*10**(K5-1)
02280L7=(INT(X1/10**(K5-1))-1)*10**(K5-1)
02290GOTO 2320
02300I=X2-INT(X1/(10**K5))*10**K5
02310L7=INT(X1/(10**K5))*10**K5
02320I=I/I5
02330X0=I
02340GOSUB 2430
02350I2=I-INT(I/(10**K5))*10**K5
02360I2=INT(I2/(10**(K5-1)))
02370IF I2<5 THEN 2400
02380I2=10**K5*(INT(I/(10**K5))+1)
02390GOTO 2410
02400I2=10**K5*(INT(I/(10**K5)))+5*10**(K5-1)
02410RETURN
02420REM************** GETDIGIT********************
02430K5=LOG(X0)/LOG(10)
02440RETURN
02450REM*******************************************LIS
02460PRINT
02470PRINT "----------------------------------------"
02480PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
02490GOSUB 9000
02500REM
02510I5=3
02520REM*******************************************LIS
02530Z0=1
02540FOR Z0=2 TO N0
02550IF X(Z0+O1*N0-N0) <> X(1+O1*N0-N0) THEN 2600
02560NEXT Z0
02570PRINT
02580PRINT "REENTER. THIS IS A SINGLE VALUED VARIABLE."
02590Z0=0
02600RETURN
02610GOTO 280
08490REM----------  READ IN TEMPORARY DATA FILE
08500 REM
08510RESTORE#6 
08511  INPUT#  6 ,L1$,J6 
08512RESTORE#4
08513INPUT#4,M$
08514INPUT#4,G6
08515INPUT#4,V0
08516INPUT#4,G$
08517INPUT#4,V$
08518FOR I=1 TO 12
08519INPUT#4,E(I)
08520NEXT I
08530IF J6 <> 0 THEN 8700
08550IF G6=0 THEN 8840
08700N0=0
08710N1=0
08720FOR J=1 TO J6-1
08730N1=N1+E(J)
08750NEXT J
08760FOR J=1 TO N1*V0
08765  INPUT#4,O1
08766NEXT J
08820N0=E(J6)
08830GOTO 8880
08840N0=E(1)
08880FOR J=1 TO N0*V0
08890  INPUT#4,X(J)
08900NEXT J
08910RETURN
08920CHAIN "CMOD10"
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09050REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.  2 INPUTS
09055INPUT O1,O2
09065IF O1=-9999 THEN 9080
09070IF O2=-9999 THEN 9080
09075RETURN
09080CHAIN "RSTRT"
09090REM*************END ROUTINE
09999 END