Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0113/cmod85.bas
There are 2 other files named cmod85.bas in the archive. Click here to see a list.
00020REM     CMOD85     CMOD85     CMOD85     CMOD85     CMOD85
00030  DIM                     N(12),J(5),K(5)
00040  DIM S(5,5),T(15,8)
00050  DIM                             I(5),G(15)
00060DATA 1,2,4,8,3,5,6,9,10,12,7,11,13,14,15
00070MAT  READ G
00080D0=0
00085  B$="                        "
00090  H$="       PREDICTOR   "
00092  Y$="       COMBINATIONS"
00093  F$=" ST DEV     R      DF"
00094  X$="RESIDUAL  MULT       "
00110V9=0
00120O9=1
00130  FILES RFILE1,RFILE2,RFILE3,RF4,,,RF7,RF8 
00170RESTORE#1
00171  INPUT#  1,I1,I2,I3
00180SCRATCH#1
00181  PRINT #  1,80,I2,I3
00190RESTORE#2
00191 INPUT#2,C7
00192 INPUT#2,G7
00200RESTORE#4
00201INPUT#4,N$
00202INPUT#4,M
00203INPUT#4,P
00204INPUT#4,G$
00205INPUT#4,V$
00206 FOR I=1 TO 12
00207 INPUT#4,N(I)
00210 NEXT I
00212MAT S=ZER(P,P)
00220MAT T=ZER(2**(P-1)-1,P+3)
00222RESTORE#7
00223FOR I=1 TO P
00224 FOR J=1 TO P
00225 INPUT#7,S(I,I)
00226 NEXT J
00227 NEXT I
00228 FOR I=1 TO 2**(P-1)-1
00229 FOR J=1 TO P+3
00230 INPUT#7,T(I,J)
00232 NEXT J
00233NEXT I
00238IF G7=0 THEN 260 
00240S0=N(G7)
00250GOTO 280
00260S0=N(1)
00270REM         S0 IS NUMBER OF OBSERVATIONS
00280I5=0
00290S3=0
00300PRINT L$
00340PRINT
00350  PRINT H$;MID$(B$,1,8+8*(P-3)-(1)+1);X$
00355  PRINT Y$;MID$(B$,1,8+8*(P-3)-(1)+1);F$
00360S3=0
00370I4=0
00380V8=0
00390I9=2 ** (P-1)-1
00400FOR I7=1 TO 15
00410IF G(I7)>2 ** (P-1)-1 THEN 890
00420I4=I4+1
00430I9=G(I7)
00440MAT J=ZER(P)
00450I5=0
00460GOSUB 1150
00470FOR J=1 TO P-1
00480I5=I5+K(J)
00490NEXT J
00495C0=I5+1
00500K0=0
00510K3=0
00515 K$=""
00520FOR J=1 TO P
00530IF J=C7 THEN 600
00540J(J)=K(J-K0)
00550IF J(J)=0 THEN 580
00560 K$=K$+MID$(V$,J*6-5,6)
00570GOTO 620
00580K3=K3+1
00590GOTO 620
00600K0=1
00610K3=K3+1
00620NEXT J
00621 R1$=MID$(K$,1,6)
00622 R2$=MID$(K$,7,6) 
00623 R3$=MID$(K$,13,6) 
00624 R4$=MID$(K$,19,6) 
00630IF T(I4,P+2)=9999 THEN 640
00632GOTO 760
00640  ONP-1  GOTO 650,670,700,730
00650CHAIN "CERROR"
00660:##.   'CCCCC  'CCCCC  'CCCCC  'CCCCC      NON-INVERTIBLE MATRIX
00670  PRINT  USING 660,I9,R1$,R2$,R3$,R4$ 
00680GOTO 890
00690:##.   'CCCCC  'CCCCC  'CCCCC      NON-INVERTIBLE MATRIX
00700  PRINT  USING 690,I9,R1$,R2$,R3$ 
00710GOTO 890
00720:##.   'CCCCC  'CCCCC      NON-INVERTIBLE MATRIX
00730  PRINT  USING 720,I9,R1$,R2$ 
00740GOTO 890
00760M5=T(I4,P+1)
00770R2=T(I4,P+2)
00780V6=S0-C0
00790  ONP-1  GOTO 800,880,850,820
00800CHAIN "CERROR"
00810:##.   'CCCCC  'CCCCC  'CCCCC  'CCCCC    ######.##  ##.###  ####
00820  PRINT  USING 810,I4,R1$,R2$,R3$,R4$,M5,R2,V6 
00830GOTO 890
00840:##.   'CCCCC  'CCCCC  'CCCCC    ######.##  ##.###  ####
00850  PRINT  USING 840,I4,R1$,R2$,R3$,M5,R2,V6 
00860GOTO 890
00870:##.   'CCCCC  'CCCCC    ######.##  ##.###  ####
00880  PRINT  USING 870,I4,MID$(K$,1,6-(1)+1),MID$(K$,7,12-(7)+1),M5,R2,V6
00890NEXT I7
00900PRINT
00910PRINT "TYPE THE NUMBER OF THE COMBINATION OF INTEREST (NONE=0).";
00920GOSUB 9000
00930IF O1 <> 0 THEN 950
00940CHAIN "CMOD78"
00950O1=INT(O1)
00960IF O1<1 THEN 980
00970IF O1 <= 2 ** (P-1)-1 THEN 1000
00980PRINT "REENTER.  INPUT MUST BE NUMBER OF PREDICTOR SET."
00990GOTO 920
01000IF T(O1,P+2)=9999 THEN 1060
01010FOR I=1 TO P
01020J(I)=T(O1,I)
01030NEXT I
01040J(C7)=0
01050GOTO 1080
01060PRINT "REENTER.  YOU SELECTED A SET WITH AN NON-INVERTIBLE MATRIX."
01070GOTO 920
01080SCRATCH#7
01081 FOR I=1 TOP
01082 FOR J=1 TO P
01083PRINT#7,S(I,J) 
01084 NEXT J
01085NEXT I
01086 FOR I=1 TO 2**(P-1)-1
01087 FOR J=1 TO P+3
01088 PRINT#7,T(I,J) 
01089 NEXT J
01090 NEXT I
01100SCRATCH#8
01110FOR I=1 TO P+3
01112IF I <> C7 THEN 1120
01115 PRINT#8,0
01116GOTO 1130
01120 PRINT#8,T(O1,I)
01130NEXT I
01140CHAIN "CMOD83"
01150REM   ROUTINE TO CREATE LINEAR COMBINATIONS
01160K0=1
01170I1=I9
01180MAT K=ZER(P-1)
01190I0=I1/2
01200I2=INT(I1/2)
01210IF I0=I2 THEN 1230
01220K(K0)=1
01230IF I2=0 THEN 1270
01240K0=K0+1
01250I1=I2
01260GOTO 1190
01270RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999END