Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0113/cmod70.bas
There are 2 other files named cmod70.bas in the archive. Click here to see a list.
00020REM***********************************************************
00030REM CMOD70 CMOD70 CMOD70 CMOD70 CMOD70
00040REM***********************************************************
00050REM INTERMEDIATE MODULE FOR LINEAR MODEL-COMP15 AND 16
00060REM CAN NOT CHAIN TO FROM CMONTR
00070REM***********************************************************
00080FILES RFILE1,RFILE2,RFILE3,,,RF6,RF7,RF8
00120RESTORE#1
00121 INPUT# 1,I1,I2,I3
00130RESTORE#7
00131INPUT#7,G0
00132INPUT#7,S8
00133INPUT#7,G5
00134INPUT#7,R0
00140D5=G0
00150 DIM X(12,12),A(12,12),B(12,12),C(12,12),D(12,12),E(12,12)
00160 DIM P(12,12),Q(1,12),R(12,1),S(12,1),T(12,12),U(12,12)
00170 DIM O(12,1),K(12,1),H(12),V(12),F(12,12),G(12,12),I(12),J(12,12)
00180J=1
00190MAT X=ZER(D5,D5)
00191 MAT T=ZER(D5,D5)
00200 DIM Z(12,1),M(12,12)
00210FOR I=1 TO D5
00220 INPUT#7,X(I,I)
00230NEXT I
00240MAT T=INV(X)
00245 MAT X=T
00250REM X IS NOW (X'X)-1
00260MAT O=CON(D5,1)
00270MAT D=CON(R0,D5)
00280MAT C=CON(R0,1)
00290MAT V=CON(R0)
00291FORI=1TOD5
00292INPUT#7,O(I,1)
00293NEXTI
00294 FOR I=1 TO R0
00295FORJ=1TOD5
00296INPUT#7,D(I,J)
00297NEXTJ
00298NEXTI
00299FORI=1TOR0
00300 INPUT#7,C(I,1)
00301NEXTI
00302FORI=1TOR0
00303INPUT#7,V(I)
00304NEXTI
00310REM O IS VECTOR OF MEANS
00320D5=R0
00330IF I1 <> 69 THEN 800
00340PRINT L$
00350PRINT " SUMMARY OF PARAMETERIZATION FOR THIS ANALYSIS."
00360PRINT " "
00370FOR I=1 TO D5
00380IF C(I,1)=2 THEN 410
00390NEXT I
00400GOTO 480
00410PRINT "YOU HAVE CONDITIONALIZED ON"
00420FOR I=1 TO D5
00430IF C(I,1) <> 2 THEN 460
00440:PARAMETER ##=#####.##
00450PRINT USING 440,I,V(I)
00460NEXT I
00470PRINT " "
00480FOR I=1 TO D5
00490IF C(I,1)=3 THEN 520
00500NEXT I
00510GOTO 590
00520PRINT "YOU HAVE MARGINALIZED ON"
00530FOR I=1 TO D5
00540IF C(I,1) <> 3 THEN 570
00550:PARAMETER ##
00560PRINT USING 550,I
00570NEXT I
00580PRINT " "
00590PRINT "YOUR NEW PARAMETERS ARE DEFINED BY"
00595 J=1
00600FOR I=1 TO D5
00610IF C(I,1) <> 1 THEN 650
00620:PARAMETER ##= PARAMETER ##
00630PRINT USING 620,J,I
00640J=J+1
00650NEXT I
00660PRINT " "
00670PRINT "TO CONTINUE TYPE '1'"
00680PRINT "TO RESPECIFY TYPE '0'.";
00690GOSUB 9000
00700IF O1 <> 0 THEN 770
00710RESTORE#1
00711 INPUT# 1,I1,I2,I3
00715IF I3=15 THEN 760
00720IF I2=1 THEN 750
00730SCRATCH#1
00731 PRINT # 1,89,I2,I3
00740GOTO 760
00750SCRATCH#1
00751 PRINT # 1,75,I2,I3
00760CHAIN "CMOD69"
00770IF O1=1 THEN 800
00780PRINT "RESPECIFY MUST BE '0' OR '1'.";
00790GOTO 690
00800K0=0
00810K1=0
00820K2=0
00830FOR I=1 TO D5
00835IFC(I,1)=OTHEN850
00840 ONC(I,1) GOTO 850,910,880
00850K0=K0+1
00860N(K0)=K0+K1
00870GOTO 940
00880K1=K1+1
00890I(K1)=I
00900GOTO 940
00910K2=K2+1
00920H(K2)=I
00930V(K2)=V(I)
00940NEXT I
00950C5=K2
00960U5=D5-C5
00970MAT A=CON(D5,G0)
00980MAT B=CON(G0,D5)
00990MAT C=CON(D5,D5)
01000MAT E=CON(D5,D5)
01010MAT M=CON(G0,G0)
01020MAT M=X
01030PRINT L$
01040MAT A=D*M
01050MAT B=TRN(D)
01060MAT C=A*B
01070MAT E=INV(C)
01080MAT K=CON(D5,1)
01090MAT K=D*O
01100MAT F=CON(U5,U5)
01110IF C5 <> 0 THEN 1170
01120U=0
01130MAT Z=CON(D5,1)
01140MAT Z=D*O
01150MAT F=C
01160GOTO 1680
01170J1=0
01180REM------ FIND NON-CONDITIONALIZING VARIABLES
01190FOR I=1 TO D5
01200FOR J=1 TO C5
01210IF I=H(J) THEN 1250
01220NEXT J
01230J1=J1+1
01240I(J1)=I
01250NEXT I
01260FOR I=1 TO U5
01270FOR J=1 TO U5
01280F(I,J)=E(I(I),I(J))
01290NEXT J
01300NEXT I
01310REM------ SET UP COVAR SUBMATRIX ROW=CON COL=NON-COND VAR
01320MAT J=CON(U5,C5)
01330FOR I=1 TO U5
01340FOR J=1 TO C5
01350J(I,J)=E(I(I),H(J))
01360NEXT J
01370NEXT I
01380MAT P=CON(C5,C5)
01385 MAT T=ZER(C5,C5)
01390FOR I=1 TO C5
01400FOR J=1 TO C5
01410P(I,J)=C(H(I),H(J))
01420NEXT J
01430NEXT I
01440REM-----SET UP THE THETA-THETA-CAP
01450MAT R=CON(C5,1)
01460MAT S=CON(U5,1)
01470MAT Q=CON(1,C5)
01480FOR I=1 TO C5
01490R(I,1)=V(I)-K(H(I),1)
01500NEXT I
01510FOR I=1 TO U5
01520S(I,1)=K(I(I),1)
01530NEXT I
01540MAT Q=TRN(R)
01549 MAT T=ZER(U5,U5)
01550MAT T=INV(F)
01555 MAT F=T
01560MAT T=CON(U5,1)
01570MAT T=J*R
01580MAT U=CON(U5,1)
01590MAT U=F*T
01600MAT Z=CON(U5,1)
01610MAT Z=S-U
01620 MAT T=INV(P)
01625 MAT P=T
01630MAT T=CON(C5,1)
01640MAT T=P*R
01650MAT U=CON(1,1)
01660MAT U=Q*T
01670U=U(1,1)
01680S8=S8+U
01690G2=G5+C5
01700MAT P=ZER(K0,K0)
01710FOR I=1 TO K0
01720FOR J=1 TO K0
01730P(I,J)=F(N(I),N(J))*S8/(G5+C5)
01740NEXT J
01750NEXT I
01760MAT U=ZER(K0,1)
01770SCRATCH#8
01771 PRINT#8,G5+C5
01772PRINT#8,K0
01773PRINT#8,S8
01780K1=1
01790FOR I=1 TO K0
01800U(K1,1)=Z(N(I),1)
01810K1=K1+1
01820NEXT I
01830FORI=1TOK0
01831FORJ=1TOK0
01832PRINT#8,P(I,J)
01833NEXTJ
01834NEXTI
01835FORI=1TOK0
01836PRINT#8,U(I,1)
01837NEXTI
01840RESTORE#1
01841 INPUT# 1,I1,I2,I3
01850IF I1 <> 69 THEN 1870
01860SCRATCH#3
01861 PRINT # 3,70
01870CHAIN "CMOD69"
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09999END