Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50422/cmod81.bas
There are 2 other files named cmod81.bas in the archive. Click here to see a list.
00023PRINT L$
00025 RANDOMIZE
00030REM*****************************************************************
00040REM     CMOD81     CMOD81     CMOD81     CMOD81     CMOD81
00050REM*****************************************************************
00060  DIM J(5),Q(6),X(333,5)                    ,N(12)
00070  DIM T(8)
00080  DIM K(5)
00100  H$=" PREDICTED  OBSERVED"
00110  FILES RFILE1,RFILE2,RFILE3,RF4,,,,RF8 
00120X=0
00160RESTORE#1
00161  INPUT#  1,I1,I2,I3
00170SCRATCH#1
00171  PRINT #  1,80,I2,I3
00180RESTORE#2
00181  INPUT#  2,C7,G7
00190GOSUB 1120
00200K=0
00205 K$=""
00210MAT T=ZER(P+3)
00220MAT Q=ZER(P+1)
00230 RESTORE#8
00232 FOR I=1 TO P+3
00234 INPUT#8,T(I)
00236 NEXT I
00240FOR I=1 TO P
00250IF T(I)=0 THEN 300
00260K=K+1
00270 K$=K$+MID$(V$,I*6-5,6)
00280Q(K)=T(I)
00290P(K)=I
00300NEXT I
00310Q(P+1)=T(P+3)
00320I5=K
00330GOTO 490
00332PRINT "   OBSERVED     PREDICTED      RESIDUAL"
00333GOTO 480
00340GOTO 332
00341  PRINT MID$(B$,1,I5*10-(1)+1);H$
00342 R1$=MID$(K$,1,6)
00343R2$=MID$(K$,7,6)
00344 R3$=MID$(K$,13,6)
00345 R4$=MID$(K$,19,6)
00346 R5$=MID$(V$,C7*6-5,6)
00350  ONI5  GOTO 460,370,400,430
00360:  'CCCCC    'CCCCC         'CCCCC
00370  PRINT  USING 360,R1$,R2$,R5$ 
00380GOTO 470
00390:  'CCCCC    'CCCCC    'CCCCC         'CCCCC
00400  PRINT  USING 390,R1$,R2$,R3$,R5$ 
00410GOTO 470
00420:  'CCCCC    'CCCCC    'CCCCC    'CCCCC         'CCCCC
00430  PRINT  USING 420,R1$,R2$,R3$,R4$,R5$ 
00440GOTO 470
00450:  'CCCCC         'CCCCC
00460  PRINT  USING 450,R1$,R5$ 
00470REM
00480RETURN
00490IF S0 <= 15 THEN 620
00500PRINT L$
00510PRINT "THE OBSERVED AND MEAN PREDICTED CRITERION VALUES CAN BE"
00520PRINT "DISPLAYED FOR"
00530PRINT "     1. YOUR ENTIRE DATA SET."
00540PRINT "     2. A RANDOM SAMPLE OF SIZE 10 FROM OUR DATA SET"
00550PRINT
00560PRINT "TYPE NUMBER OF OPTION YOU WANT (NEITHER=0).";
00570GOSUB 9000
00580IF O1=1 THEN 630
00590IF O1=2 THEN 630
00600PRINT "REENTER.  MUST BE NUMBER OF OPTION."
00610GOTO 570
00620O1=1
00630O5=O1
00632PRINT L$
00640GOSUB 340
00650  ONO5  GOTO 710,660
00660GOSUB 1330
00665FOR J=1 TO 10
00670I=D(J)
00680GOSUB 870
00690NEXT J
00700GOTO 820
00710K=0
00720FOR I=1 TO S0
00730GOSUB 870
00740IF K <> 14 THEN 800
00745IF S0=15 THEN 820
00750PRINT
00760PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00770GOSUB 9000
00773PRINT L$
00776GOSUB 340
00780K=0
00800K=K+1
00810NEXT I
00820PRINT
00822PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
00830GOSUB 9000
00840CHAIN "CMOD83"
00850IF S0>15 THEN 860
00860GOTO 490
00870O0=X(I,C7)
00880P0=Q(P+1)
00890  ONI5  GOTO 960,940,920,900
00900P4=X(I,P(4))
00910P0=P0+P4*Q(4)
00920P3=X(I,P(3))
00930P0=P0+P3*Q(3)
00940P2=X(I,P(2))
00950P0=P0+P2*Q(2)
00960P1=X(I,P(1))
00970P0=P0+P1*Q(1)
00972:#######.##    #######.##    #######.##
00974PRINT  USING 972,O0,P0,P0-O0
00975GOTO 1110
00980  ONI5  GOTO 1090,1060,1030,1000
00990:######.## ######.## ######.## ######.## ######.## ######.##
01000PRINT  USING 990,P1,P2,P3,P4,P0,O0
01010GOTO 1110
01020:######.## ######.## ######.## ######.## ######.##
01030PRINT  USING 1020,P1,P2,P3,P0,O0
01040GOTO 1110
01050:######.## ######.## ######.## ######.##
01060PRINT  USING 1050,P1,P2,P0,O0
01070GOTO 1110
01080:######.## ######.## ######.##
01090PRINT  USING 1080,P1,P0,O0
01100GOTO 1110
01110RETURN
01120RESTORE#4
01121 INPUT#4,N$
01122INPUT#4,M
01123 INPUT#4,P
01124 INPUT#4,G$
01125 INPUT#4,V$
01130 FOR I=1 TO 12
01132 INPUT#4,N(I)
01133 NEXT I
01140IF M=0 THEN 1250
01150IF G7=1 THEN 1250
01160S0=0
01170FOR I=1 TO G7-1
01180S0=S0+N(I)
01190NEXT I
01200FOR I=1 TO S0*P
01210  INPUT#4,C3
01220NEXT I
01230S0=N(G7)
01240GOTO 1260
01250S0=N(1)
01260MAT X=ZER(S0,P)
01270FOR I=1 TO P
01280FOR J=1 TO S0
01290  INPUT#4,X(J,I)
01300NEXT J
01310NEXT I
01320RETURN
01330  DIM D(10),C(333)
01340MAT C=ZER(S0)
01350FOR I=1 TO 10
01360D(I)=1+INT(RND(0)*S0)
01370IF C(D(I))=0 THEN 1390
01380GOTO 1360
01390C(D(I))=1
01400NEXT I
01410RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999 END