Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50422/cmod11.bas
There are 2 other files named cmod11.bas in the archive. Click here to see a list.
00020 DIM X(1000) ,S(12)
00040 N$="1234567890"
00070REM CMOD11 CMOD11 CMOD11 CMOD11 CMOD11 CMOD11 CMOD11
00105REM RUN THROUGH 1TOC1 / C0=0 / C1=1 / C2=2 / C3=3 / C4=4 / C5=5 / C6=6
00106READ C0,C1,C2,C3,C4,C5,C6
00107DATA 0,1,2,3,4,5,6
00110 F$="DFIL "
00120FILES RFILE1,RFILE2,RFILE3,RF4, , ,RF7, ,RF9
00160RESTORE#1
00161 INPUT# 1,I1,I2,I3
00170SCRATCH#1
00171 PRINT # 1,42,I2,I3
00180IF I2=1 THEN 330
00190PRINT L$
00200PRINT " DATA ENTRY"
00210PRINT
00220PRINT "YOU ARE ENTERING THIS MODULE WITH A DATA SET. THIS MODULE"
00230PRINT "IS FOR CREATING A NEW DATA SET. IT IS NOT FOR MODIFYING A"
00240PRINT "DATA SET. IF YOU WANT TO MODIFY USE MODULE 2-DATA EDITTING."
00250PRINT
00260PRINT "IF YOU WANT TO EXIT THIS MODULE TYPE '1', ELSE '0'.";
00270GOSUB 9000
00280IF O1=0 THEN 330
00290IF O1=1 THEN 320
00300PRINT "REENTER. INPUT MUST BE 0 OR 1."
00310GOTO 270
00320CHAIN "CMOD10"
00330 DIM O(6)
00340D3=C0
00350V1=C1
00360Q1=C0
00370N1=C1
00380N0=C0
00390X0=C0
00400X1=C0
00410X2=C0
00420MAT X=CON
00430MAT S=ZER
00440 V$="VAR-1 VAR-2 VAR-3 VAR-4 VAR-5 "
00460PRINT L$
00470PRINT " DATA ENTRY "
00480PRINT
00490GOSUB 1750
00500PRINT L$
00510PRINT "YOU CAN CONSTRUCT A DATA SET WITH A MAXIMUM OF 1000 ENTRIES."
00520PRINT "THE DATA MAY BE GROUPED (MAX=12) OR UNGROUPED, UNIVARIATE"
00530PRINT "OR MULTIVARIATE (MAX=5)."
00540PRINT
00550PRINT " 1. UNGROUPED UNIVARIATE "
00560PRINT " 2. UNGROUPED MULTIVARIATE"
00570PRINT " 3. GROUPED UNIVARIATE"
00580PRINT " 4. GROUPED MULTIVARIATE"
00590PRINT
00600PRINT "TYPE THE NUMBER OF THE KIND OF DATA YOU HAVE.";
00610GOSUB 9000
00620IF O1=1 THEN 710
00630IF O1=2 THEN 810
00640IF O1=3 THEN 870
00650IF O1=4 THEN 930
00660PRINT "REENTER. INPUT MUST BE NUMBER OF OPTION."
00670GOTO 610
00680REM****************************************************************
00690REM UNGROUPED UNIVARIATE DATA
00710V0=C1
00720J6=C1
00730GOSUB 2380
00740GOSUB 2200
00750G6=C0
00760GOSUB 2610
00770GOTO 3490
00790REM UNGROUPED MULTIVARIATE DATA
00800REM
00810GOSUB 1420
00820J6=C1
00830GOTO 740
00840REM ******************************************************************
00850REM GROUPED UNIVARIATE DATA
00860REM
00870V0=C1
00880GOSUB 2380
00890GOTO 940
00910REM GROUPED MULTIVARIATE DATA
00920REM
00930GOSUB 1420
00940GOSUB 1270
00950GOSUB 1540
00960J6=C1
00970IF G5=0 THEN 1030
00980PRINT L$
00990PRINT "INPUT NAME FOR GROUP ";J6;".";
01000INPUTZ$
01001Z$=RIGHT$(" "+Z$,6)
01002G$=G$+Z$
01010PRINT
01020GOTO 1110
01030G$=G$+"GRP-"
01040PRINT L$
01042IFJ6>=10THEN1045
01043G$=G$+" "
01044GOTO1050
01045G$=G$+"1"
01050G$=G$+MID$(N$,J6,J6-J6+1)
01080 PRINT "GROUP NAME IS ";MID$(G$,J6*C6-C5,J6*C6-(J6*C6-C5)+1)
01090PRINT
01100D3=C0
01110PRINT "INPUT THE NUMBER OF OBSERVATIONS IN THE GROUP.";
01120GOSUB 9000
01130IF O1+N0>1000 THEN 1240
01140IF O1<1 THEN 1220
01150G7=O1
01160N1=C1
01170N0=G7
01180GOSUB 2610
01190IF J6=G6 THEN 4460
01200J6=J6+C1
01210GOTO 970
01220PRINT "REENTER. MINIMUM NUMBER OF ENTRIES IS 1."
01230GOTO 1120
01240PRINT "REENTER. FOR ALL GROUPS THE TOTAL NUMBER OF ENTRIES"
01250PRINT "EXCEEDS THE MAXIMUM OF 1000."
01260GOTO 1120
01270PRINT
01280REM***********************************************************
01290REM NUMBER OF GROUPS IN DATA SET
01310PRINT "INPUT THE NUMBER OF GROUPS IN YOUR DATA SET (MAX=12).";
01320GOSUB 9000
01330IF O1>12 THEN 1370
01340IF O1<2 THEN 1370
01350G6=O1
01360RETURN
01370PRINT "REENTER. MINIMUM IS 2 AND MAXIMUM IS 12."
01380GOTO 1320
01400REM NUMBER OF VARIABLES IN DATA SET
01410REM
01420PRINT " "
01430PRINT "INPUT THE NUMBER OF VARIABLES IN YOUR DATA SET (MAX=5).";
01440GOSUB 9000
01450IF O1>5 THEN 1490
01460IF O1<1 THEN 1490
01470V0=O1
01480GOTO 2380
01490PRINT "REENTER. MINIMUM IS 1 AND MAXIMUM IS 5."
01500GOTO 1440
01510REM***********************************************************
01520REM GROUP NAMES
01540PRINT L$
01550PRINT "YOU CAN ASSIGN GROUP NAMES OR LET THE MODULE ASSIGN THE"
01560PRINT "NAMES GRP-1, GRP-2, ETC."
01570G5=C0
01580PRINT
01590PRINT "LET MODULE ASSIGN NAMES=1 YOU ASSIGN NAMES=2 ";
01600GOSUB 9000
01610IF O1=1 THEN 1630
01620G5=C1
01630RETURN
01640PRINT
01650PRINT "INPUT THE NUMBER OF ENTRIES IN YOUR DATA SET (MAX=1000).";
01660GOSUB 9000
01670IF O1 >= 2 THEN 1700
01680PRINT "REENTER. MINIMUM IS 2 AND THE MAXIMUM IS 1000."
01690GOTO 1660
01700IF O1>1000 THEN 1680
01710RETURN
01720REM***********************************************************
01730REM DO YOU NEED TO FILE YOUR DATA SET
01750PRINT "IF YOU WANT TO STORE YOUR DATA ON A FILE YOU SHOULD SET "
01760PRINT "THAT FILE UP AT THIS TIME."
01770PRINT
01780PRINT "DO NOT SET UP FILE=1 SET UP FILE=2 ";
01790GOSUB 9000
01800IF O1=2 THEN 1840
01810IF O1=1 THEN 2160
01820PRINT "REENTER. INPUT MUST BE 1 OR 2."
01830GOTO 1790
01840PRINT
01850PRINT "IN ORDER TO STORE DATA ON A FILE YOU MUST HAVE A"
01860PRINT "PASSWORD. IF YOU DO NOT HAVE A PASSWORD THEN YOU "
01870PRINT "SEE THE SYSTEMS MANAGER."
01880PRINT
01890PRINT "IF YOU HAVE A PASSWORD TYPE IT, ELSE '0'.";
01900INPUT T$
01910 IF MID$(T$,1,1-(1)+1)="0" THEN 2050
01930 IF MID$(T$,1,5-(1)+1) <> "WPASS" THEN 2030
01940FOR I=1 TO 6
01950 O1=VAL( MID$(T$,6,6-(6)+1) )
01960IF O1=I THEN 2130
01970NEXT I
02030PRINT "THIS IS NOT A VALID PASSWORD."
02040PRINT
02050PRINT "YOU CAN NOT STORE YOUR DATA ON A FILE UNLESS YOU HAVE A"
02060PRINT "VALID PASSWORD."
02070PRINT
02080PRINT "IF YOU WANT TO GO AHEAD AND ENTER YOUR DATA AND NOT STORE"
02090PRINT "IT ON A FILE TYPE '1', ELSE '0'.";
02100GOSUB 9000
02110IF O1 <> 1 THEN 9110
02120RETURN
02130 REM
02131 F$="DFIL0"
02132 F$=F$+MID$(T$,6,1)
02135SCRATCH#1
02136 PRINT # 1,I1,I2,I3,F$
02140SCRATCH#7
02141 PRINT # 7 ,F$,T$
02150PRINT
02160RETURN
02170REM*************************************************************
02180REM NUMBER OF OBSERVATIONS
02190REM
02200PRINT
02210:INPUT THE NUMBER OF OBSERVATIONS MAX=####.
02220PRINT USING 2210,INT(1000/V0)
02230GOSUB 9000
02240O1=INT(O1)
02250IF O1>INT(1000/V0) THEN 2290
02260IF O1 >= 2 THEN 2320
02270PRINT "REENTER. MINUMUM NUMBER OF OBSERVATIONS IS 2."
02280GOTO 2200
02290PRINT "REENTER NUMBER OF VARIABLES AND OBSERVATIONS. TOTAL NUMBER"
02300PRINT "OF ENTRIES ALLOWED (VARIABLES X OBSERVATIONS) IS 1000."
02310GOTO 610
02320N0=O1
02330RETURN
02340REM****************************************************************
02350REM
02370REM
02380PRINT
02390PRINT "YOU CAN EITHER SPECIFY THE VARIABLE NAMES OR LET THE"
02400PRINT "MODULE ASSIGN THE NAMES VAR-1, VAR-2, ETC.."
02410PRINT
02420PRINT "LET MODULE ASSIGN THE NAMES =1 YOU ASSIGN NAMES=2 ";
02430GOSUB 9000
02440V5=O1
02450IF O1=2 THEN 2490
02460IF O1=1 THEN 2560
02470PRINT "REENTER. INPUT MUST BE 1 OR 2."
02480GOTO 2410
02490PRINT L$
02500PRINT "INPUT THE VARIABLE NAMES. MAXIMUM LENGTH IS 6 CHARACTERS."
02510PRINT
02520 V$=""
02521FOR I=V1TO V0
02530PRINT "NAME FOR VARIABLE ";I;".";
02540Z$=" "
02541INPUT R$
02542R$=R$+Z$
02543 V$=V$+MID$(R$,1,6)
02550NEXT I
02560RETURN
02570PRINT L$
02590REM INPUTS OBVSERVATIONS N1 THROUGH N0 IN GROUPS OF 10
02600REM
02610FOR J=N1 TO N0 STEP 10
02620PRINT L$
02630PRINT "INPUT THE VARIABLE VALUES FOR THIS SET OF OBSERVATIONS."
02640IF X0=1 THEN 2660
02650PRINT "INPUT THE VALUES SEPARATED BY COMMAS."
02660PRINT
02670X0=C1
02680IF J+9<N0 THEN 2710
02690I5=N0
02700GOTO2720
02710I5=J+9
02720REM
02730PRINT"OBSERVATIONS ";
02731:###
02732SCRATCH#9
02733PRINT#9USING2731,J-N1+C1
02734RESTORE#9
02735INPUT#9,Z$
02736PRINTZ$;
02737PRINT" - ";
02738SCRATCH#9
02739PRINT#9USING2731,I5-N1+C1
02740RESTORE#9
02741INPUT#9,Z$
02742PRINTZ$
02750PRINT"VARIABLES ";
02760FOR I9=V1 TO V0
02761Z$=MID$(V$,I9*C6-C5,I9*C6-(I9*C6-C5)+1)
02762GOTO2783
02770:'CCCCC
02779SCRATCH#9
02780PRINT#9USING2770,MID$(V$,I9*C6-C5,I9*C6-(I9*C6-C5)+1)
02781RESTORE#9
02782INPUT#9,Z$
02783PRINTZ$;
02784PRINT" ";
02790NEXT I9
02800PRINT
02810PRINT "--------------------------------------------------------"
02820V2=V0
02830V0=V0-V1+C1
02840FOR I=J TO I5
02850:"OBS ###:"
02860SCRATCH#9
02861PRINT#9USING2850,I-J+C1
02862RESTORE#9
02863INPUT#9,Z$
02864PRINTZ$;
02870 ONV0 GOTO 2880,2900,2920,2940,2960,2980
02880INPUT O(C1)
02890GOTO 2990
02900INPUT O(C1),O(C2)
02910GOTO 2990
02920INPUT O(C1),O(C2),O(C3)
02930GOTO 2990
02940INPUT O(C1),O(C2),O(C3),O(C4)
02950GOTO 2990
02960INPUT O(C1),O(C2),O(C3),O(C4),O(C5)
02970GOTO 2990
02980INPUT O(C1),O(C2),O(C3),O(C4),O(C5),O(C6)
02990FOR J2=V1 TO V0
03000X(Q1+I+J2*N0-N0)=O(J2)
03010NEXT J2
03020NEXT I
03030V0=V2
03040PRINT "--------------------------------------------------------"
03050IF X1=1 THEN 3110
03060PRINT "IF YOU WANT TO CONTINUE INPUT TYPE '1'."
03070PRINT "IF YOU WANT TO EDIT THIS SET OF OBSERVATIONS TYPE '2'."
03080PRINT "IF YOU WANT TO STOP INPUTTING DATA TYPE '3'."
03090PRINT
03100X1=C1
03110PRINT "CONTINUE INPUT=1 CONTINUE BUT EDIT=2 STOP INPUT=3 ";
03120GOSUB 9000
03130IF O1=1 THEN 3480
03140IF O1=2 THEN 3540
03150IF O1=3 THEN 3360
03160PRINT "REENTER. INPUT MUST BE 1,2,OR 3."
03170GOTO 3110
03180N0=I5-D3
03190IF G6=0 THEN 3210
03200S(J6)=I5-D3
03210IF D3=0 THEN 3340
03220K5=C1
03230K6=I5*V0
03240IF X(Q1+K5) <> -7.6543E-19 THEN 3310
03250IF K5=K6 THEN 3340
03260FOR K7=K5+C1 TO K6
03270X(Q1+K7-C1)=X(Q1+K7)
03280NEXT K7
03290K6=K6-C1
03300GOTO 3240
03310IF K5=K6 THEN 3340
03320K5=K5+C1
03330GOTO 3240
03340Q1=Q1+S(J6)*V0
03350RETURN
03360PRINTL$
03370PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
03380PRINT " 1. KEEP DATA ALREADY ENTERED."
03390PRINT " 2. DO NOT KEEP DATA ALREADY ENTERED."
03400GOSUB 9000
03410IF O1=1 THEN 3500
03420IF O1=2 THEN 3460
03430PRINT "REENTER. INPUT MUST BE 1 OR 2."
03440GOTO 3360
03450CHAIN "RSTRT"
03460N0=C0
03470GOTO 4460
03480NEXT J
03490N0=I5
03500PRINT L$
03510GOSUB 3180
03520IF G6=0 THEN 4460
03530RETURN
03540K4=J
03550K3=I5
03560GOSUB 3610
03570GOSUB 4240
03580GOSUB 3760
03590GOTO 3480
03610PRINT L$
03620REM
03630PRINT " VARIABLES"
03640:
03650PRINT " OBS. ";
03660:" ##.='CCCCC"
03670FOR J3=C1 TO V0
03671Z$=MID$(V$,J3*C6-C5,J3*C6-(J3*C6-C5)+1)
03672SCRATCH#9
03673PRINT#9USING3660,J3,Z$
03674RESTORE#9
03675INPUT#9,Z$
03678IFJ3=V0THEN3681
03679PRINTZ$;
03680GOTO3682
03681PRINTZ$
03682NEXTJ3
03700RETURN
03710REM******************************************************************
03730REM ROUTINE TO EDIT THE OBSERVATIONS
03760PRINT "-------------------------------------------------------------"
03770IF X2=1 THEN 3840
03780PRINT "IF YOU WANT TO CONTINUE WITHOUT EDITTING TYPE '1'."
03790PRINT "IF YOU WANT TO DELETE AN OBSERVATION TYPE '2'."
03800PRINT "IF YOU WANT TO CHANGE AN OBSERVATION TYPE '3'."
03810PRINT "IF YOU WANT TO REDISPLAY THE OBSERVATIONS TYPE '4'."
03820PRINT
03830X2=C1
03840PRINT "CONTINUE=1 DELETE=2 CHANGE=3 REDISPLAY=4 ";
03850GOSUB 9000
03860IF O1=3 THEN 3920
03870IF O1=2 THEN 4040
03880IF O1=4 THEN 4190
03890IF O1=1 THEN 4170
03900PRINT "REENTER. INPUT MUST BE 1, 2, 3, OR 4."
03910GOTO 3850
03920REM
03930PRINT"INPUT OBS#, VAR#, NEW VALUE "
03940GOSUB 9130
03950O1=O1+K4-C1
03960IF INT(O1)>K3 THEN 4000
03970IF INT(O1)<K4 THEN 4000
03980IF INT(O2)>V0 THEN 4000
03990IF INT(O2) >= 1 THEN 4020
04000PRINT "REENTER. CHECK YOUR OBSERVATION AND VARIABLE NUMBERS."
04010GOTO 3930
04020X(O1+Q1+O2*N0-N0)=O3
04030GOTO 3840
04040REM
04050PRINT"INPUT OBS# ";
04060GOSUB 9000
04070O1=O1+K4-C1
04080IF INT(O1)>K3 THEN 4100
04090IF INT(O1) >= K4 THEN 4120
04100PRINT "REENTER. INPUT MUST BE NUMBER OF DISPLAYED OBSERVATION."
04110GOTO 4050
04120D3=D3+C1
04130FOR D0=C1 TO V0
04140X(Q1+O1+D0*N0-N0)=-7.6543E-19
04150NEXT D0
04160GOTO 3840
04170RETURN
04190GOSUB 3610
04200GOSUB 4240
04210GOTO 3760
04220RETURN
04230REM
04240PRINT "-------------------------------------------------------------"
04250FOR K5=K4 TO K3
04260:"### "
04261SCRATCH#9
04262PRINT#9USING4260,K5-K4+C1
04263RESTORE#9
04264INPUT#9,Z$
04270PRINTZ$;
04280FOR K6=C1 TO V0
04290IF X(Q1+K5+K6*N0-N0)=-7.6543E-19 THEN 4320
04300GOTO 4340
04310:
04320PRINT" DELETED ";
04330GOTO 4420
04340IF ABS(X(Q1+K5+K6*N0-N0))<1.E+06 THEN 4410
04350GOTO 4380
04360IF ABS(X(K5+Q1+K6*N0-N0))>1 THEN 4410
04370: #####^^^^
04380SCRATCH#9
04381PRINT#9USING4370,X(K5+Q1+K6*N0-N0)
04382RESTORE#9
04383INPUT#9,Z$
04384PRINT" ",Z$;
04390GOTO 4420
04400:"#######.## "
04410SCRATCH#9
04411PRINT#9USING4400,X(K5+Q1+N0*K6-N0)
04412RESTORE#9
04413INPUT#9,Z$
04415PRINTZ$;
04420NEXT K6
04430PRINT
04440NEXT K5
04450RETURN
04460PRINT " DESCRIPTION OF DATA SET"
04470PRINT
04480PRINT "VARIABLES"
04490FOR K=C1 TO V0
04500:##. 'CCCCC
04510 PRINT USING 4500,K,MID$(V$,K*C6-C5,K*C6-(K*C6-C5)+1)
04520NEXT K
04530PRINT
04540IF G6=0 THEN 4680
04550PRINT " GROUP OBS."
04560FOR K=C1 TO G6
04570:##. 'CCCCC ####
04580 PRINT USING 4570,K,MID$(G$,K*C6-C5,K*C6-(K*C6-C5)+1),S(K)
04590NEXT K
04600N0=C0
04610FOR J=C1 TO G6
04620N0=N0+S(J)
04630NEXT J
04640PRINT
04650PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
04660GOSUB 9000
04670GOTO 4720
04680S(C1)=N0
04690:NUMBER OF OBSERVATIONS =#####
04700PRINT USING 4690,S(C1)
04710GOTO 4640
04720SCRATCH#4
04721 PRINT #4,"NONAME"
04722 PRINT #4,G6
04723 PRINT #4,V0
04724 PRINT #4,CHR$(34);G$;CHR$(34)
04725 PRINT #4,CHR$(34);V$;CHR$(34)
04730FOR I=1TO12
04731PRINT#4,S(I)
04732NEXTI
04740FOR J=C1 TO N0*V0
04750PRINT#4,X(J)
04760NEXT J
04770SCRATCH#1
04771 PRINT # 1,I1,C2,I3
04772RESTORE#7
04773 INPUT #7,S$
04774 IF MID$(S$,1,1)<>"D" THEN 4780
04775 CHAIN"CMOD17"
04780CHAIN "CMOD10"
04840PRINT"OBS. ";
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09010INPUT O1
09020IF O1=-9999 THEN 9040
09030RETURN
09040CHAIN "RSTRT"
09050REM*************END ROUTINE
09060REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 2 INPUTS
09070INPUT O1,O2
09080IF O1=-9999 THEN 9110
09090IF O2=-9999 THEN 9110
09100RETURN
09110CHAIN "RSTRT"
09130REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 3 INPUTS
09140INPUT O1,O2,O3
09150IF O1=-9999 THEN 9190
09160IF O2=-9999 THEN 9190
09170IF O3=-9999 THEN 9190
09180RETURN
09190CHAIN "RSTRT"
09999END