Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
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