BEGIN 00000100 COMMENT PROGRAM - FACVAR, 00000200 CUBE LIBRARY NUMBER IS T800001. 00000300 THIS VERSION DATED 5/31/67; 00000400 COMMENT FACTOR ANALYSIS 00000500 CHARLES L. CLARK 00000600 PROFESSIONAL SERVICES DIVISIONAL GROUP 00000700 BURROUGHS CORPORATION 00000800 PROGRAM CONTAINS 712 CARDS 00000900 FIRST RELEASE DATE DEC. 1, 1964 ; 00001000 COMMENT DATE LAST REVISED: 14 SEPTEMBER 1965 00001100 REVISED BY: FORREST F. CARHART, III ;00001200 COMMENT DATE LAST REVISED DECEMBER 15,1966 BY J. HORN ; 00001300 INTEGER I,NVAR,NSAM,CAS,NRO ; 00001400 INTEGER QZ,INP,COMM,PNCH,COVARPRNT ; 00001500 INTEGER SFMT; 00001600 INTEGER ARRAY ID[0:4] ; 00001700 BOOLEAN TR ; 00001800 REAL LIM ; 00001900 LABEL START,NOMO,LL1 ; 00002000 FORMAT IN FORM1 (5A6,I3,I5,I3,F5.2,I3,L5,6I1), 00002100 FORM2 (40I2), 00002200 FORM3(26I3); 00002300 FORMAT CHKFOR (A6); 00002400 FORMAT PUNCHOUT ( 16F5.2/X5,15F5.2); 00002500 FORMAT NOFRM ("ERROR: NO FORMAT SPECIFICATIONS FOR THIS RUN"//);00002600 FORMAT ERRCNT ("ERROR: WRONG N INDICATED ON HEADER CARD" //); 00002700 LABEL WRONGCOUNT; 00002800 FORMAT SWF (////////////////////////////////////////////////// 00002900 ////////////////////////////////////////////////// 00003000 ////////////////////////////////////////////////// 00003100 //////////////////////////////////////////////////);00003200 FORMAT COF (////////////////////////////////////////////////// 00003300 ////////////////////////////////////////////////// 00003400 ////////////////////////////////////////////////// 00003500 //////////////////////////////////////////////////);00003600 COMMENT 00003700 FORM4 (12F6.1) ; 00003800 FORMAT OUT TITLE(X52,"FACTOR ANALYSIS"///), 00003900 FRM1 (X45,5A6//X1,"CASE",I3/X1,"NUMBER OF VARIABLES",I4/ 00004000 X1,"SAMPLE SIZE",I6), 00004100 FRM2 (//X1,"MEAN VALUE OF VARIABLES"), 00004200 FRM3 (8F15.5), 00004300 FRM4 (//X1,"STANDARD DEVIATIONS"), 00004400 FRM5 (//X1,"CORRELATION COEFFICIENTS"), 00004500 FRM52(//X1,"COVARIANCES"), 00004600 FRM6 (/X1,"ROW",I3/(10F12.5)/), 00004700 FRM7 (//X1,"EIGENVALUES"), 00004800 FRM8 (//X7,"ACCURACY INSUFFICIENT FOR MORE EIGENVALUES"), 00004900 FRM9 (//X1,"CUMULATIVE PROPORTION OF TOTAL VARIANCE"), 00005000 FRM10(//X1,"EIGENVECTORS"), 00005100 FRM11(/X1,"VECTOR",I3/(10F12.5)/), 00005200 FRM12(//X1,"FACTOR MATRIX"), 00005300 FRM13(/X1,"VARIABLE",I3/(10F12.5)/), 00005400 FRM14(//X1,"CHECK MATRIX - EIGENVALUES ON DIAGONAL"), 00005500 FRM15(//X1,"CHECK MATRIX - CORRELATION COEFFICIENTS"), 00005600 FRM16(//X1,"VALUE GIVEN TO LIMIT NUMBER OF FACTORS TO BE",00005700 " ROTATED",F9.4/), 00005800 FRM17(//X1,"FACTOR MATRIX CAN NOT BE ROTATED, CHANGE THE",00005900 " LIMIT VALUE LIM"/), 00006000 FRM18(/X1,"NUMBER OF FACTORS ROTATED",I4/X1,"NUMBER OF ", 00006100 "ITERATION CYCLES",I3///X1,"ROTATED FACTOR MATRIX"),00006200 FRM19(/X1,"ORIGINAL AND SUCCESSIVE VARIANCES"//X3,"CYCLE",00006300 " NO.",X10,"VARIANCES"), 00006400 FRM20(I8,X8,F15.7), 00006500 FRM21(//X1,"CHECK ON COMMUNALITIES"//X3,"VARIABLES",X8, 00006600 "ORIGINAL",X9,"FINAL",X8,"DIFFERENCE"), 00006700 FRM22(I8,X5,3F15.5) ; 00006800 FILE IN CARD(2,10); 00006900 DEFINE CARDR=CARD#; 00007000 FILE OUT PRINT 4(2,15); 00007100 FILE OUT PUNCH 0 (2,15); 00007200 DEFINE LINE=PRINT#; 00007300 PROCEDURE OBJECTFMTGEN(INFORMAT);FORMAT INFORMAT;BEGIN OWN REAL NCR,NFWD00007400 ,ELCLASS;OWN REAL LCR;OWN INTEGER CNT,TCNT,RSLT,F;OWN INTEGER FMAX;OWN R00007500 EAL ARRAY ACCUM[0:9];SAVE OWN REAL ARRAY GENF[0:259];SAVE OWN REAL ARRAY00007600 IMAG[0:9];OWN REAL ARRAY PRNT[0:19];OWN BOOLEAN ERRTOG;LABEL FINISHED;S00007700 TREAM PROCEDURE TATTLE(F,LINE);VALUE F;BEGIN SI~LOC F;DI~LINE;10(DS~LIT"00007800 ");DS~9LIT"FMT SIZE ";DS~3DEC;DS~4LIT" WDS";47(DS~2LIT" ");END OF TATT00007900 LE;PROCEDURE FLAG(ERRNUM);INTEGER ERRNUM;BEGIN STREAM PROCEDURE INSERT(E00008000 RR,LINE,ACCUM,CNT);VALUE ERR,CNT;BEGIN SI~LOC ERR;DI~LINE;10(DS~LIT"X");00008100 DS~16LIT" SYNTAX ERROR #";DS~3DEC;DS~4LIT" ..";SI~ACCUM;SI~SI+3;DS~CNT00008200 CHR;DS~4LIT".. ";10(DS~LIT"X");36(DS~2LIT" ");END OF INSERT;INSERT(ER00008300 RNUM,PRNT[0],ACCUM[1],CNT);WRITE(LINE,15,PRNT[*]);ERRTOG~TRUE;END OF FLA00008400 G;PROCEDURE ERR(ERRNUM);INTEGER ERRNUM;BEGIN FLAG(ERRNUM);END;REAL STREA00008500 M PROCEDURE SETUP(CARD,LINE,LCR);BEGIN LOCAL SET1;SI~CARD;DI~LINE;DS~10W00008600 DS;40(DS~2LIT" ");SI~CARD;SET1~SI;DI~LOC SETUP;SI~LOC SET1;DS~WDS;DI~CA00008700 RD;9(DI~DI+8);SET1~DI;DS~LIT"%";SI~LOC SET1;DI~LCR;DS~WDS;END OF SETUP;R00008800 EAL STREAM PROCEDURE FMTF(FMTIN);BEGIN LOCAL ST;SI~FMTIN;DI~LOC FMTF;ST~00008900 SI;SI~LOC ST;DS~WDS;END OF FMTF;REAL STREAM PROCEDURE EXAMIN(NCR);VALUE 00009000 NCR;BEGIN SI~NCR;DI~LOC EXAMIN;DI~DI+7;DS~CHR;END OF EXAMIN;REAL STREAM 00009100 PROCEDURE CONV(ACCUM,SKP,N);VALUE SKP,N;BEGIN SI~ACCUM;SI~SI+SKP;SI~SI+300009200 ;DI~LOC CONV;DS~N OCT;END OF CONV;REAL PROCEDURE CONVERT;BEGIN REAL T;IN00009300 TEGER N;T~CONV(ACCUM[1],TCNT,N~(CNT-TCNT)MOD 8);FOR N~TCNT+N STEP 8UNTIL00009400 CNT-1DO T~T|100000000+CONV(ACCUM[1],N,8);CONVERT~T;END OF CONVERT;STREA00009500 M PROCEDURE SCAN(NCRV,NCR,ACCUM,CNT,CNTV,RSLT,RSLTV,AC);VALUE NCRV,CNTV,00009600 RSLTV,AC;BEGIN LOCAL ST1,ST2;LABEL DEBLANK,GETCHR,NUMBER,EXIT,FINIS;LABE00009700 L L;SI~NCRV;DI~RSLT;DI~DI+7;CI~CI+RSLTV;GO TO FINIS;GO TO FINIS;GO TO FI00009800 NIS;GO TO NUMBER;GO TO FINIS;GO TO GETCHR;GO TO FINIS;DEBLANK:IF SC=" "T00009900 HEN BEGIN L:SI~SI+1;IF SC=" "THEN GO TO L;END;GO TO FINIS;GETCHR:DS~LIT"00010000 2";TALLY~1;SI~SI+1;GO TO EXIT;NUMBER:TALLY~63;DS~LIT"3";AC(TALLY~TALLY+100010100 ;IF SC<"0"THEN JUMP OUT TO EXIT;SI~SI+1);EXIT:ST1~TALLY;TALLY~TALLY+CNTV00010200 ;ST2~TALLY;DI~CNT;SI~LOC ST2;DS~WDS;DI~ACCUM;SI~SI-3;DS~3CHR;DI~DI+CNTV;00010300 SI~NCRV;DS~ST1 CHR;FINIS:DI~NCR;ST1~SI;SI~LOC ST1;DS~WDS;END OF SCAN;PRO00010400 CEDURE READACARD;BEGIN READ(CARD,10,IMAG[*]);NCR~SETUP(IMAG[0],PRNT[0],L00010500 CR);WRITE(LINE,15,PRNT[*]);END OF READACARD;PROCEDURE SCANNER;BEGIN LABE00010600 L L;L:SCAN(NCR,NCR,ACCUM[1],CNT,CNT,RSLT,RSLT,63-CNT);IF NCR=LCR THEN BE00010700 GIN READACARD;GO TO L;END;END OF SCANNER;PROCEDURE NEXTENT;BEGIN CNT~ACC00010800 UM[1]~0;IF EXAMIN(NCR)=" "THEN BEGIN RSLT~7;SCANNER;END DEBLANK;IF EXAMI00010900 N(NCR){9THEN BEGIN RSLT~3;SCANNER;TCNT~0;IF CNT>4THEN FLAG(140)ELSE IF E00011000 LCLASS~-CONVERT<-1023THEN FLAG(140)END ELSE BEGIN RSLT~5;SCANNER;ELCLASS00011100 ~ACCUM[1].[18:6];END;END OF NEXTENT;STREAM PROCEDURE MOVECODE(TEMP,FINAL00011200 ,RPT,REM);VALUE RPT,REM;BEGIN LOCAL ST1;SI~TEMP;DI~FINAL;DS~REM WDS;ST1~00011300 SI;SI~LOC RPT;SI~SI+7;IF SC!"0"THEN BEGIN SI~ST1;RPT(DS~63WDS);END;END O00011400 F MOVECODE;PROCEDURE MAXWDS(INFORMAT);FORMAT INFORMAT;BEGIN OWN INTEGER 00011500 CTR,FLG;LABEL RETURN,EX;INTEGER STREAM PROCEDURE WDCTR(FMT,CTR,FLG);VALU00011600 E CTR;BEGIN LOCAL ST1;LABEL SCAN,FND,EXIT;SI~LOC CTR;SI~SI+7;DI~LOC ST1;00011700 DS~4LIT"0000";DI~DI-4;IF SC="0"THEN BEGIN SI~FMT;GO TO SCAN;END;SI~FMT;C00011800 TR(63(SI~SI+8));SCAN:63(IF 4SC=DC THEN JUMP OUT TO FND;TALLY~TALLY+1;DI~00011900 DI-4;SI~SI+4);ST1~TALLY;GO TO EXIT;FND:ST1~TALLY;SI~SI-4;DI~FLG;DS~WDS;E00012000 XIT:SI~LOC ST1;DI~LOC WDCTR;DS~WDS;END OF WDCTR;FMAX~CTR~FLG~0;RETURN:FM00012100 AX~FMAX+WDCTR(INFORMAT,CTR,FLG);IF FLG!0THEN GO TO EX;CTR~CTR+1;GO TO RE00012200 TURN;EX:END OF MAXWDS;STREAM PROCEDURE LARGER(LINE,F);VALUE F;BEGIN SI~L00012300 OC F;DI~LINE;10(DS~LIT"X");DS~41LIT" FORMAT TOO LARGE (RECEIVER FMT SIZ00012400 E IS ";DS~3DEC;DS~9LIT" WORDS) ";10(DS~LIT"X");47(DS~LIT" ");END OF LAR00012500 GER;PROCEDURE GETINT;BEGIN NEXTENT;IF ELCLASS~-ELCLASS<0THEN BEGIN FLAG(00012600 137);ELCLASS~0END END GETINT;INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2);VALU00012700 E NUMBER;INTEGER P1,P2,NUMBER;BEGIN IF NUMBER<0THEN BEGIN FLAG(138);NUMB00012800 ER~0END;P1~IF NUMBER<8THEN NUMBER ELSE 8;NUMBER~NUMBER-P1;P2~IF NUMBER<800012900 THEN NUMBER ELSE 8;DIVIDE~NUMBER-P2 END DIVIDE;STREAM PROCEDURE WHIPOUT(00013000 NFWDV,W,NFWD);VALUE NFWDV;BEGIN LOCAL ST;SI~W;DI~NFWDV;DS~WDS;ST~DI;DI~N00013100 FWD;SI~LOC ST;DS~WDS;END OF WHIPOUT;BOOLEAN PROCEDURE FORMATPHRASE;BEGIN00013200 LABEL EL,EX,EXIT,L1,L2,L3;PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,00013300 W2,D1,D2);VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2;REAL CODE,REPEAT,SKIP,W00013400 ,W1,W2,D1,D2;BOOLEAN S;BEGIN IF W>63THEN FLAG(163);W~REPEAT&W[6:42:6]&SK00013500 IP[32:42:6]&W1[28:44:4]&W2[24:44:4]&D1[20:44:4]&D2[16:44:4]&CODE[2:44:4]00013600 &REAL(S)[1:47:1];F~F+1;WHIPOUT(NFWD,W,NFWD);END EMITFORMAT;STREAM PROCED00013700 URE PACKALPHA(PLACE,LETTER,CTR);VALUE LETTER,CTR;BEGIN DI~PLACE;DS~LIT"B00013800 ";SI~LOC CTR;SI~SI+7;DS~CHR;SI~PLACE;SI~SI+3;DS~5CHR;SI~LOC LETTER;SI~SI00013900 +7;DS~CHR END PACKALPHA;INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE;BOOLEAN S00014000 ;INTEGER ST;DEFINE RRIGHT=0#,RLEFT=4#,RSTROKE=6#;DEFINE RSCALE=8#,RR=15#00014100 ;DEFINE RD=0#,RX=2#,RA=4#,RI=6#,RF=8#,RE=10#,RO=12#,RL=14#;IF ELCLASS<0T00014200 HEN BEGIN REPEAT~-ELCLASS;NEXTENT;IF ELCLASS=","THEN GO EX END ELSE REPE00014300 AT~REAL(ELCLASS!"("AND ELCLASS!"<");IF ELCLASS="("OR ELCLASS="<"THEN BEG00014400 IN SKIP~F;EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0);DO BEGIN NEXTENT;EL:00014500 IF FORMATPHRASE THEN GO TO EX END UNTIL ELCLASS!",";WHILE ELCLASS="/"DO 00014600 BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0);NEXTENT END;IF ELCLASS!")"A00014700 ND ELCLASS!">"THEN GO TO EL;IF REPEAT=0THEN EMITFORMAT(TRUE,RSTROKE,1,0,00014800 0,0,0,0,0);S~TRUE;REPEAT~F-SKIP;CODE~RRIGHT END ELSE IF ELCLASS="O"THEN 00014900 BEGIN CODE~RO;W~8END ELSE IF ELCLASS="D"THEN BEGIN CODE~RD;W~8END ELSE I00015000 F ELCLASS=","THEN GO TO L2 ELSE IF ELCLASS="/"THEN GO TO EXIT ELSE IF EL00015100 CLASS=")"OR ELCLASS=">"THEN GO TO EXIT ELSE IF ELCLASS="S"THEN BEGIN NEX00015200 TENT;W~IF ELCLASS="-"THEN 1ELSE 0;IF ELCLASS>0THEN NEXTENT;IF ELCLASS>0T00015300 HEN BEGIN ERR(136);GO TO EXIT END ELSE REPEAT~-ELCLASS;EMITFORMAT(TRUE,R00015400 SCALE,REPEAT,0,W,0,0,0,0);GO TO L2 END ELSE IF ELCLASS="""THEN BEGIN COD00015500 E~100;ST~0;DO BEGIN SKIP~1;DO BEGIN RSLT~5;CNT~0;SCANNER;IF ELCLASS~ACCU00015600 M[1].[18:6]=CODE THEN BEGIN IF SKIP!1THEN BEGIN WHIPOUT(NFWD,W,NFWD);F~F00015700 +1;END;GO TO L2 END;CODE~""";PACKALPHA(W,ELCLASS,SKIP);END UNTIL SKIP~SK00015800 IP+1=7;WHIPOUT(NFWD,W,NFWD);F~F+1;END UNTIL(ST~ST+6)>132;GO TO EX END EL00015900 SE BEGIN CODE~ELCLASS;GETINT;W~ELCLASS;IF CODE="I"THEN BEGIN SKIP~DIVIDE00016000 (W,W1,W2);CODE~RI END ELSE IF CODE="F"THEN BEGIN CODE~RF;GO TO L1 END EL00016100 SE IF CODE="R"THEN BEGIN CODE~RR;GO TO L1 END ELSE IF CODE="E"THEN BEGIN00016200 CODE~RE;D1~1;L1:NEXTENT;IF ELCLASS!"."THEN GO TO EX;GETINT;IF DIVIDE(EL00016300 CLASS+D1,D1,D2)>0THEN GO TO EX;IF CODE=RF OR CODE=RR THEN SKIP~DIVIDE(W-00016400 ELCLASS-1,W1,W2)ELSE IF SKIP~W-ELCLASS-6<0THEN GO TO EX END ELSE IF CODE00016500 ="X"THEN BEGIN CODE~RX;W1~W.[38:4];SKIP~W~W.[42:6]END ELSE IF CODE="A"TH00016600 EN BEGIN CODE~RA;W1~6;GO TO L3 END ELSE IF CODE="L"THEN BEGIN CODE~RL;W100016700 ~5;L3:IF W200;F~@40*2;END;ERRTOG~FORMATPHR00017200 ASE;IF ELCLASS=";"THEN GO TO FINISHED;FLAG(119);FINISHED:TATTLE(F,PRNT[000017300 ]);WRITE(LINE,15,PRNT[*]);MAXWDS(INFORMAT);IF F>FMAX THEN BEGIN LARGER(P00017400 RNT[0],FMAX);WRITE(LINE,15,PRNT[*]);ERRTOG~TRUE;END;NCR~0&(F+1)[24:39:9]00017500 ;WHIPOUT(NFWD,NCR,NFWD);CNT~(F+1)DIV 63;TCNT~(F+1)MOD 63;IF ERRTOG THEN 00017600 BEGIN NCR~TIME(1);DO F~0UNTIL TIME(1)-NCR>200;F~@40*2;END;MOVECODE(GENF,00017700 INFORMAT,CNT,TCNT);END OF OBJECTFMTGEN; 00017800 PROCEDURE DATELINE(PROGRAM);VALUE PROGRAM;ALPHA PROGRAM;BEGIN OWN BOOLEA00017900 N USED;FORMAT HD(A4,I3,", ",A4,X2,"TIME:",I5,X10,"OUTPUT FROM PROGRAM ",00018000 A6,X10,"UNIVERSITY OF DENVER COMPUTING CENTER"///),LAYT(//"EXECUTION TIM00018100 E =",I5,X03,"I/O TIME =",I5," SECONDS ",A4,I3,", ",A4,X03,"TIME:",I7///00018200 );LABEL GOTIT;ALPHA MO,MINS,FEB,HRS,YR,DAY;USED~USED AND PROGRAM.[18:6]=00018300 0;DAY~TIME(0);YR~DAY.[18:12]+"1900";DAY~DAY.[42:6]+10|DAY.[36:6]+100|DAY00018400 .[30:6];FEB~IF YR.[42:6]MOD 4=0 THEN"(FEB."ELSE"&FEB.";FOR MO~"~JAN.",FE00018500 B,"~MAR.","3 THEN 00025000 BEGIN 00025100 FILE IN CORMAT 2(2,100); 00025200 FORMAT FCM( 00025300 12F6.3 00025400 ); 00025500 IF CAS = 4 THEN RN ~ 1.0; 00025600 IF QZ < 1 THEN 00025700 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00025800 BEGIN 00025900 READ(CARD,SWF,CAS4); 00026000 WRITE(PRINT,FRM5); 00026100 WRITE(PRINT,FRM6,CORR); 00026200 END ELSE 00026300 BEGIN 00026400 READ(CORMAT,OKTL,NVAR,NVAR); 00026500 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00026600 READ(CORMAT,OKTL,CAS4); 00026700 END; 00026800 IF CAS!6 THEN GO TO LL33; 00026900 COMMENT IF CORRELATIONS ARE READ IN FOR CASE 6 THE MAIN DIAGONAL 00027000 SHOULD CONTAIN THE STANDARD DEVIATIONS ; 00027100 FOR I~1 STEP 1 UNTIL NVAR DO 00027200 FOR J~1 STEP 1 UNTIL NVAR DO 00027300 R[I,J] ~ SCA[I,J] | NSAM | SCA[I,I] | SCA[J,J]; 00027400 FOR J ~ 1 STEP 1 UNTIL NVAR DO BEGIN 00027500 A[J,1] ~ SCA[J,J]; A[J,3] ~ SCA[J,J]|SCA[J,J]|NSM1; 00027600 END; 00027700 GO TO LCAS6; 00027800 END ; 00027900 READ (CARDR,FORM2,SCAL) ; 00028000 IF CAS = 1 THEN 00028100 RN ~ 1.0 ; 00028200 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00028300 BEGIN 00028400 A[I,2] ~ 0.0 ; 00028500 A[I,3] ~ 0.0 ; 00028600 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00028700 SUMXX[I,J] ~ 0.0 00028800 END ; 00028900 IF TR THEN 00029000 READ (CARDR,FORM3,TRAN) ; 00029100 FOR M ~ 1 STEP 1 UNTIL NSAM DO 00029200 BEGIN 00029300 IF QZ = 1 THEN IF INP>1 AND INP<5 THEN 00029400 READ(FILESW[INP],OKTL,DATR)[WRONGCOUNT] ELSE BEGIN 00029500 WRITE(LINE,<"INPUT TAPE INCORRECTLY SPECIFIED">); 00029600 GO TO NOMO END ELSE 00029700 READ(CARD, SWF, DATR)[WRONGCOUNT]; 00029800 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00029900 BEGIN 00030000 X[J] ~ DATA[J]|10.0*SC[J] ; 00030100 DATA[J] ~ X[J] 00030200 END ; 00030300 IF TR THEN 00030400 BEGIN 00030500 FOR J ~ NVAR STEP -1 UNTIL 1 DO 00030600 BEGIN 00030700 GO TO U[T[J]] ; 00030800 L1: GO TO NAXT ; 00030900 L2: DATA[J] ~ X[J]|X[J] ; 00031000 GO TO NAXT ; 00031100 L3: DATA[J] ~ 1 / X[J] ; 00031200 GO TO NAXT ; 00031300 L4: DATA[J] ~ SQRT(X[J]) ; 00031400 GO TO NAXT ; 00031500 L5: DATA[J] ~ EXP(X[J]) ; 00031600 GO TO NAXT ; 00031700 L6: DATA[J] ~ LN(X[J]) ; 00031800 GO TO NAXT ; 00031900 L7: DATA[J] ~ SIN(X[J]) ; 00032000 GO TO NAXT ; 00032100 L8: DATA[J] ~ COS(X[J]) ; 00032200 GO TO NAXT ; 00032300 L9: DATA[J] ~ X[J+1] ; 00032400 GO TO NAXT ; 00032500 L10: DATA[J] ~ X[J+2] ; 00032600 GO TO NAXT ; 00032700 L11: DATA[J] ~ X[J+3] ; 00032800 GO TO NAXT ; 00032900 L12: DATA[J] ~ X[J+4] ; 00033000 GO TO NAXT ; 00033100 L13: DATA[J] ~ X[J+5] ; 00033200 GO TO NAXT ; 00033300 L14: DATA[J] ~ X[J+6] ; 00033400 GO TO NAXT ; 00033500 L15: DATA[J] ~ X[J+7] ; 00033600 GO TO NAXT ; 00033700 NAXT: END 00033800 END ; 00033900 FOR L ~ 1 STEP 1 UNTIL NVAR DO 00034000 BEGIN 00034100 A[L,2] ~ A[L,2] + DATA[L] ; 00034200 A[L,3] ~ A[L,3] + DATA[L]|DATA[L] 00034300 END ; 00034400 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00034500 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00034600 SUMXX[J,K] ~ SUMXX[J,K] + DATA[J]|DATA[K] 00034700 END ; 00034800 JJ ~ NVAR - 1 ; 00034900 FOR I ~ 1 STEP 1 UNTIL JJ DO 00035000 BEGIN 00035100 KK ~ I + 1 ; 00035200 FOR J ~ KK STEP 1 UNTIL NVAR DO 00035300 SUMXX[J,I] ~ SUMXX[I,J] 00035400 END ; 00035500 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00035600 SUMX[I] ~ A[I,2]/NS ; 00035700 WRITE(PRINT,FRM2) ; 00035800 WRITE(PRINT,FRM3,AVEX) ; 00035900 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00036000 BEGIN 00036100 SUMX[J] ~ A[J,3] - ((A[J,2]|A[J,2])/NS) ; 00036200 A[J,1] ~ SQRT(SUMX[J]/NSM1) 00036300 END ; 00036400 WRITE(PRINT,FRM4) ; 00036500 WRITE(PRINT,FRM3,SDEV) ; 00036600 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00036700 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00036800 R[I,J] ~ SUMXX[I,J] - ((A[I,2]|A[J,2])/NS) ; 00036900 COMMENT HERE FOLLOWS A ROUTINE TO GIVE THE COVARIANCE MATRIX IF 00037000 SUCH IS DESIRED AND DSIGNATED IN THE PARAMETER CARD ; 00037100 IF COVARPRNT > 0 THEN BEGIN 00037200 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00037300 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00037400 SCA[I,J] ~ R[I,J]/NSM1 ; 00037500 WRITE(PRINT,FRM52); 00037600 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00037700 WRITE(PRINT,FRM6,CORR); 00037800 END; 00037900 FOR K ~ 1 STEP 1 UNTIL JJ DO 00038000 BEGIN 00038100 KK ~ K+1 ; 00038200 FOR L ~ KK STEP 1 UNTIL NVAR DO 00038300 R[L,K] ~ R[K,L] 00038400 END ; 00038500 LL ~ NVAR - 1 ; 00038600 IF CAS < 3 THEN 00038700 GO TO LL3 ; 00038800 LCAS6: BEGIN 00038900 REAL ARRAY SCA[0:NVAR,0:NVAR]; 00039000 COMMENT TO AVOID USING SAME ARRAY AS READ INTO IN CASE 6; 00039100 LL ~ NVAR - 1 ; 00039200 FOR II ~ 1 STEP 1 UNTIL NVAR DO 00039300 BEGIN 00039400 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00039500 T[I] ~ I ; 00039600 FOR I ~ II STEP 1 UNTIL LL DO 00039700 T[I] ~ T[I+1] ; 00039800 T[NVAR] ~ II ; 00039900 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00040000 BEGIN 00040100 JJ ~ T[J] ; 00040200 FOR I ~ 1 STEP 1 UNTIL J DO 00040300 BEGIN 00040400 KK ~ T[I] ; 00040500 SUMXX[I,J] ~ R[KK,JJ] 00040600 END 00040700 END ; 00040800 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00040900 A[1,J] ~ SUMXX[1,J] ; 00041000 FOR I ~ 1 STEP 1 UNTIL LL DO 00041100 BEGIN 00041200 FOR J ~ I STEP 1 UNTIL NVAR DO 00041300 SCA[I,J] ~ A[I,J]/A[I,I] ; 00041400 MM ~ I+1 ; 00041500 FOR J ~ MM STEP 1 UNTIL NVAR DO 00041600 BEGIN 00041700 S ~ 0.0 ; 00041800 FOR M ~ 1 STEP 1 UNTIL I DO 00041900 S ~ S + SCA[M,MM]|A[M,J] ; 00042000 A[MM,J] ~ SUMXX[MM,J] - S 00042100 END 00042200 END ; 00042300 DATA[II] ~ 0.0 ; 00042400 FOR I ~ 1 STEP 1 UNTIL LL DO 00042500 DATA[II] ~ DATA[II] + A[I,NVAR]|SCA[I,NVAR] ; 00042600 DATA[II] ~ DATA[II] / SUMXX[NVAR,NVAR] 00042700 END ; 00042800 END; 00042900 COMMENT THE FOLLOWING STATEMENT IS BELIEVED BY HORN TO BE INCORRECT 00043000 IF CAS=6 THEN GO TO LCAS6A; 00043100 LL3: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00043200 SUMX[I] ~ SQRT(SUMX[I]) ; 00043300 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00043400 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00043500 SCA[I,J] ~ R[I,J] / (SUMX[I]|SUMX[J]) ; 00043600 FOR I ~ 1 STEP 1 UNTIL LL DO 00043700 BEGIN 00043800 KK ~ I+1 ; 00043900 FOR J ~ KK STEP 1 UNTIL NVAR DO 00044000 SCA[J,I] ~ SCA[I,J] 00044100 END ; 00044200 IF CAS = 3 OR CAS = 6 THEN 00044300 LCAS6A: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00044400 SCA[I,I] ~ DATA[I] ; 00044500 LL33: IF COMM > 0 THEN BEGIN 00044600 OBJECTFMTGEN(COF); 00044700 WRITE(LINE[DBL]); 00044800 READ(CARD,COF,DATR); 00044900 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00045000 SCA[I,I] ~ DATA[I]; 00045100 END; 00045200 WRITE(LINE,FRM5); 00045300 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00045400 WRITE(PRINT,FRM6,CORR) ; 00045500 COMMENT CALCULATE EIGENVALUES AND EIGENVECTORS ; 00045600 LL34: BEGIN 00045700 REAL ARRAY IND[0:NVAR] ; 00045800 LABEL LL4,LL5,LL6,LL7,LL8,LL9,LL10,LL11,LL12,LL13,LL14,LL15, 00045900 LL16,LL17,LL18,LL19,LL20,LL21,LL22,LL36 ; 00046000 NORM ~ 0.0 ; 00046100 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00046200 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00046300 NORM ~ NORM + SCA[I,J]*2 ; 00046400 NORM ~ SQRT(NORM) ; 00046500 IF NVAR = 0 THEN 00046600 GO TO LL4 ; 00046700 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00046800 BEGIN 00046900 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00047000 R[I,J] ~ 0.0 ; 00047100 R[I,I] ~ 1.0 00047200 END ; 00047300 LL4: EX ~ 1 ; 00047400 LL ~ NVAR - 2 ; 00047500 IF LL < 0 THEN 00047600 GO TO LL23 ; 00047700 IF LL = 0 THEN 00047800 GO TO LL5 ; 00047900 FOR I ~ 1 STEP 1 UNTIL LL DO 00048000 BEGIN 00048100 II ~ I + 2 ; 00048200 FOR J ~ II STEP 1 UNTIL NVAR DO 00048300 BEGIN 00048400 T1 ~ SCA[I,I+1] ; 00048500 T2 ~ SCA[I,J] ; 00048600 LL20: IF T2 ! 0 THEN 00048700 BEGIN 00048800 LL18: TE ~ SQRT(T1|T1 + T2|T2) ; 00048900 KOS ~ T1 / TE ; 00049000 SYN ~ T2 / TE ; 00049100 IF EX = 1 THEN 00049200 GO TO LL22 00049300 ELSE 00049400 GO TO LL19 00049500 END ; 00049600 IF EX = 1 THEN 00049700 GO TO LL36 00049800 ELSE 00049900 GO TO LL18 ; 00050000 LL22: FOR K ~ I STEP 1 UNTIL NVAR DO 00050100 BEGIN 00050200 T2 ~ KOS | SCA[K,I+1] + SYN | SCA[K,J] ; 00050300 SCA[K,J] ~ KOS | SCA[K,J] - SYN | SCA[K,I+1] ; 00050400 SCA[K,I+1] ~ T2 00050500 END ; 00050600 FOR K ~ I STEP 1 UNTIL NVAR DO 00050700 BEGIN 00050800 T2 ~ KOS | SCA[I+1,K] + SYN | SCA[J,K] ; 00050900 SCA[J,K] ~ KOS | SCA[J,K] - SYN | SCA[I+1,K] ; 00051000 SCA[I+1,K] ~ T2 00051100 END ; 00051200 IF NVAR ! 0 THEN 00051300 BEGIN 00051400 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00051500 BEGIN 00051600 T2 ~ KOS | R[K,I+1] + SYN | R[K,J] ; 00051700 R[K,J] ~ KOS | R[K,J] - SYN | R[K,I+1] ; 00051800 R[K,I+1] ~ T2 00051900 END 00052000 END ; 00052100 LL36: END 00052200 END ; 00052300 LL5: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00052400 BEGIN 00052500 DIAG[I] ~ SCA[I,I] ; 00052600 SUMX[I] ~ NORM ; 00052700 VAL[I] ~ -NORM 00052800 END ; 00052900 FOR I ~ 2 STEP 1 UNTIL NVAR DO 00053000 BEGIN 00053100 SD[I-1] ~ SCA[I-1,I] ; 00053200 X[I-1] ~ SD[I-1]*2 00053300 END ; 00053400 TA ~ 0.0 ; 00053500 I ~ 1 ; 00053600 LL13: M ~ 0 ; 00053700 T2 ~ 0.0 ; 00053800 T1 ~ 1.0 ; 00053900 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00054000 BEGIN 00054100 P ~ DIAG[J] - TA ; 00054200 IF T2 = 0 THEN 00054300 GO TO LL6 ; 00054400 IF T1 = 0 THEN 00054500 GO TO LL7 ; 00054600 TE ~ P|T1 - X[J-1]|T2 ; 00054700 GO TO LL8 ; 00054800 LL6: IF T1 < 0 THEN 00054900 BEGIN 00055000 T1 ~ -1.0 ; 00055100 TE ~ -P ; 00055200 GO TO LL8 00055300 END ; 00055400 LL9: T1 ~ 1.0 ; 00055500 TE ~ P ; 00055600 GO TO LL8 ; 00055700 LL7: IF X[J-1] = 0 THEN 00055800 GO TO LL9 ; 00055900 IF T2 } 0 THEN 00056000 BEGIN 00056100 TE ~ -1.0 ; 00056200 GO TO LL8 00056300 END ; 00056400 TE ~ 1.0 ; 00056500 LL8: IF ((T1 < 0) AND (TE < 0)) OR ((T1 } 0) AND (TE } 0)) THEN00056600 M ~ M+1 ; 00056700 T2 ~ T1 ; 00056800 T1 ~ TE 00056900 ;WHILE ABS(T1)>10 OR ABS(T2)>10 DO 00057000 BEGIN 00057100 T1 ~ T1/10; 00057200 T2~ T2/10; 00057300 END; 00057400 END ; 00057500 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00057600 BEGIN 00057700 IF K { M THEN 00057800 BEGIN 00057900 IF TA > VAL[K] THEN 00058000 VAL[K] ~ TA 00058100 END 00058200 ELSE 00058300 BEGIN 00058400 IF TA < SUMX[K] THEN 00058500 SUMX[K] ~ TA 00058600 END 00058700 END ; 00058800 LL12: W ~ SUMX[I] - VAL[I] - 5.0@-8 ; 00058900 IF W { 0 THEN 00059000 GO TO LL10 ; 00059100 IF SUMX[I] = 0 THEN 00059200 GO TO LL11 ; 00059300 W ~ ABS(VAL[I] / SUMX[I] - 1.0) - 5.0@-8 ; 00059400 IF W > 0 THEN 00059500 GO TO LL11 ; 00059600 LL10: I ~ I + 1 ; 00059700 IF I > NVAR THEN 00059800 GO TO LL14 00059900 ELSE 00060000 GO TO LL12 ; 00060100 LL11: TA ~ (VAL[I] + SUMX[I]) / 2.0 ; 00060200 GO TO LL13 ; 00060300 LL14: EX ~ 2 ; 00060400 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00060500 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00060600 SCA[I,J] ~ 0.0 ; 00060700 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00060800 BEGIN 00060900 IF I = 1 THEN 00061000 GO TO LL21 ; 00061100 IF W { 0 THEN 00061200 GO TO LL16 ; 00061300 IF SUMX[I-1] ! 0 THEN 00061400 BEGIN 00061500 W ~ ABS(SUMX[I] / SUMX[I-1] - 1.0) - 5.0@-7 ; 00061600 IF W { 0 THEN 00061700 GO TO LL16 00061800 END ; 00061900 LL21: KOS ~ 1.0 ; 00062000 SYN ~ 0.0 ; 00062100 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00062200 BEGIN 00062300 IF J = 1 THEN 00062400 GO TO LL15 00062500 ELSE 00062600 GO TO LL20 ; 00062700 LL19: X[J-1] ~ SYN ; 00062800 DATA[J-1] ~ KOS ; 00062900 VAL[J-1] ~ T1|KOS + T2|SYN ; 00063000 LL15: T1 ~ (DIAG[J]-SUMX[I])|KOS - TA|SYN ; 00063100 T2 ~ SD[J] ; 00063200 TA ~ SD[J]|KOS 00063300 END ; 00063400 VAL[NVAR] ~ T1 ; 00063500 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00063600 IND[J] ~ 0 ; 00063700 LL16: TE ~ NORM ; 00063800 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00063900 BEGIN 00064000 IF IND[J] } 1 THEN 00064100 GO TO LL17 ; 00064200 IF ABS(TE) { ABS(VAL[J]) THEN 00064300 GO TO LL17 ; 00064400 TE ~ VAL[J] ; 00064500 LL ~ J ; 00064600 LL17: END ; 00064700 IND[LL] ~ 1 ; 00064800 P ~ 1.0 ; 00064900 IF LL ! 1 THEN 00065000 BEGIN 00065100 FOR K ~ 2 STEP 1 UNTIL LL DO 00065200 BEGIN 00065300 M ~ LL+1-K ; 00065400 SCA[M+1,I] ~ DATA[M]|P ; 00065500 P ~ -P|X[M] 00065600 END 00065700 END ; 00065800 SCA[1,I] ~ P 00065900 END ; 00066000 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00066100 BEGIN 00066200 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00066300 IND[K] ~ SCA[K,J] ; 00066400 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00066500 BEGIN 00066600 SCA[I,J] ~ 0.0 ; 00066700 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00066800 SCA[I,J] ~ R[I,K]|IND[K] + SCA[I,J] 00066900 END 00067000 END 00067100 END ; 00067200 LL23: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00067300 BEGIN 00067400 IF SUMX[I] { RN THEN 00067500 BEGIN 00067600 Z ~ I-1 ; 00067700 GO TO LL24 00067800 END 00067900 END ; 00068000 Z ~ NVAR ; 00068100 LL24: WRITE(PRINT,FRM7) ; 00068200 WRITE(PRINT,FRM3,EVAL) ; 00068300 IF NVAR > Z THEN 00068400 WRITE(PRINT,FRM8) ; 00068500 COMMENT CALCULATE CUMULATIVE PROPORTIONS OF TOTAL VARIANCE ; 00068600 A[1,1] ~ SUMX[1] ; 00068700 FOR I ~ 2 STEP 1 UNTIL Z DO 00068800 A[I,1] ~ A[I-1,1] + SUMX[I] ; 00068900 FOR I ~ 1 STEP 1 UNTIL Z DO 00069000 A[I,1] ~ A[I,1] / ( A[Z,1]) ; 00069100 COMMENT WAS: 00069200 A[I,1] ~ A[I,1] / (NVAR | A[Z,1]) ; 00069300 WRITE(PRINT,FRM9) ; 00069400 WRITE(PRINT,FRM3,CUMP) ; 00069500 WRITE(PRINT,FRM10) ; 00069600 FOR J ~ 1 STEP 1 UNTIL Z DO 00069700 WRITE(PRINT,FRM11,EVEC) ; 00069800 FOR I ~ 1 STEP 1 UNTIL Z DO 00069900 BEGIN 00070000 SUMX[I] ~ SQRT(SUMX[I]) ; 00070100 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00070200 A[J,I] ~ SUMX[I]|SCA[J,I] 00070300 END ; 00070400 WRITE(PRINT,FRM12) ; 00070500 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00070600 WRITE(PRINT,FRM13,FACT) ; 00070700 IF NVAR > Z THEN 00070800 BEGIN 00070900 FOR I ~ 1 STEP 1 UNTIL Z DO 00071000 FOR J ~ 1 STEP 1 UNTIL Z DO 00071100 BEGIN 00071200 R[I,J] ~ 0.0 ; 00071300 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00071400 R[I,J] ~ R[I,J] + A[K,I]|A[K,J] 00071500 END ; 00071600 WRITE(PRINT,FRM14) 00071700 END 00071800 ELSE 00071900 BEGIN 00072000 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00072100 FOR J ~ 1 STEP 1 UNTIL NVAR DO 00072200 BEGIN 00072300 R[I,J] ~ 0.0 ; 00072400 FOR K ~ 1 STEP 1 UNTIL NVAR DO 00072500 R[I,J] ~ R[I,J] + A[I,K]|A[J,K] 00072600 END ; 00072700 WRITE(PRINT,FRM15) 00072800 END ; 00072900 FOR I ~ 1 STEP 1 UNTIL Z DO 00073000 WRITE(PRINT,FRM6,CHEK) ; 00073100 WRITE(PRINT,FRM16,LIM) ; 00073200 IF LIM = 0 THEN 00073300 GO TO LL26 ; 00073400 FOR J ~ 1 STEP 1 UNTIL Z DO 00073500 BEGIN 00073600 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00073700 BEGIN 00073800 W ~ ABS(A[I,J]) ; 00073900 IF W } LIM THEN 00074000 GO TO LL25 00074100 END ; 00074200 RN ~ J-1; 00074300 GO TO LL27; 00074400 LL25: END; 00074500 LL26: RN ~ Z; 00074600 LL27: IF (NRO=0) OR (NRO>RN) THEN 00074700 NRO ~ RN; 00074800 IF NRO { 1 THEN 00074900 BEGIN 00075000 WRITE(PRINT,FRM17) ; 00075100 GO TO START 00075200 END ; 00075300 COMMENT ROTATE FACTOR MATRIX ; 00075400 LL35: BEGIN 00075500 REAL TN4P,ST,CT,S2T,C2T,S4T,C4T,TN4T,CN4T ; 00075600 LABEL LL28,LL29,LL30,LL31,LL32 ; 00075700 T1 ~ 0.00116 ; 00075800 JJ ~ 3 ; 00075900 P ~ 1.0 ; 00076000 KK ~ 0 ; 00076100 MM ~ (NRO|(NRO-1))/2 ; 00076200 DATA[1] ~ 0.0 ; 00076300 LL ~ NRO - 1 ; 00076400 II ~ 1 ; 00076500 EX ~ 0 ; 00076600 T2 ~ NVAR ; 00076700 TA ~ T2*2 ; 00076800 W ~ 1.0 / SQRT(2.0) ; 00076900 NS ~ 0.0001 ; 00077000 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00077100 SUMX[I] ~ 0.0 ; 00077200 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00077300 FOR J ~ 1 STEP 1 UNTIL NRO DO 00077400 SUMX[I] ~ SUMX[I] + A[I,J]|A[I,J] ; 00077500 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00077600 BEGIN 00077700 SUMX[I] ~ SQRT(SUMX[I]) ; 00077800 FOR J ~ 1 STEP 1 UNTIL NRO DO 00077900 A[I,J] ~ A[I,J] / SUMX[I] 00078000 END ; 00078100 LL29: II ~ II + 1 ; 00078200 DATA[II] ~ 0.0 ; 00078300 Z ~ II - 1 ; 00078400 FOR J ~ 1 STEP 1 UNTIL NRO DO 00078500 BEGIN 00078600 RN ~ 0.0 ; 00078700 BE ~ 0.0 ; 00078800 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00078900 BEGIN 00079000 S ~ A[I,J]|A[I,J] ; 00079100 RN ~ RN + S ; 00079200 BE ~ BE + S|S 00079300 END ; 00079400 DATA[II] ~ DATA[II] + (T2|BE - RN|RN)/TA 00079500 END ; 00079600 IF II } 50 THEN 00079700 GO TO LL30 ; 00079800 MARY ~ ABS(DATA[II] - DATA[Z]) - 1.0@-7 ; 00079900 IF MARY { 0 THEN 00080000 BEGIN 00080100 EX ~ EX + 1 ; 00080200 IF EX > JJ THEN 00080300 GO TO LL30 00080400 END ; 00080500 FOR J ~ 1 STEP 1 UNTIL LL DO 00080600 BEGIN 00080700 L ~ J + 1 ; 00080800 FOR K ~ L STEP 1 UNTIL NRO DO 00080900 BEGIN 00081000 IF KK } MM THEN 00081100 GO TO LL31 ; 00081200 IF ABS(P) > NS THEN 00081300 KK ~ 0 ; 00081400 RN ~ 0.0 ; 00081500 BE ~ 0.0 ; 00081600 S ~ 0.0 ; 00081700 NORM ~ 0.0 ; 00081800 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00081900 BEGIN 00082000 MARY ~ (A[I,J] + A[I,K])|(A[I,J] - A[I,K]) ; 00082100 TE ~ A[I,J]|A[I,K] ; 00082200 TE ~ TE + TE ; 00082300 S ~ S + (MARY + TE)|(MARY - TE) ; 00082400 NORM ~ NORM + 2.0|MARY|TE ; 00082500 RN ~ RN + MARY ; 00082600 BE ~ BE + TE 00082700 END ; 00082800 TE ~ NORM - 2.0|RN|BE/T2 ; 00082900 B ~ S - (RN|RN - BE|BE)/T2 ; 00083000 P ~ 0.25|ARCTAN(TE/B) ; 00083100 IF ABS(P) { NS THEN 00083200 BEGIN 00083300 KK ~ KK + 1 ; 00083400 GO TO LL31 00083500 END ; 00083600 TN4P ~ TE/B ; 00083700 IF TE = B THEN 00083800 BEGIN 00083900 IF TE + B < T1 THEN 00084000 GO TO LL31 ; 00084100 C4T ~ W ; 00084200 S4T ~ W ; 00084300 GO TO LL28 00084400 END 00084500 ELSE IF TE < B THEN 00084600 BEGIN 00084700 TN4T ~ ABS(TE)/ABS(B) ; 00084800 IF TN4T } T1 THEN 00084900 BEGIN 00085000 C4T ~ 1.0 / SQRT(1.0 + TN4T*2) ; 00085100 S4T ~ TN4T|C4T ; 00085200 GO TO LL28 00085300 END ; 00085400 IF B } 0 THEN 00085500 GO TO LL31 ; 00085600 SYN ~ W ; 00085700 KOS ~ W ; 00085800 GO TO LL32 00085900 END 00086000 ELSE 00086100 BEGIN 00086200 CN4T ~ ABS(TE/B) ; 00086300 IF CN4T } T1 THEN 00086400 BEGIN 00086500 S4T ~ 1.0 / SQRT(1.0 + CN4T*2) ; 00086600 C4T ~ CN4T|S4T ; 00086700 GO TO LL28 00086800 END ; 00086900 C4T ~ 0.0 ; 00087000 S4T ~ 1.0 00087100 END ; 00087200 LL28: C2T ~ SQRT((1.0 + C4T)/2.0) ; 00087300 S2T ~ S4T/(2.0|C2T) ; 00087400 CT ~ SQRT((1.0 + C2T)/2.0) ; 00087500 ST ~ S2T/(2.0|CT) ; 00087600 IF B > 0 THEN 00087700 BEGIN 00087800 KOS ~ CT ; 00087900 SYN ~ ST 00088000 END 00088100 ELSE 00088200 BEGIN 00088300 KOS ~ W|CT + W|ST ; 00088400 SYN ~ ABS(W|CT - W|ST) 00088500 END ; 00088600 IF TE { 0 THEN 00088700 SYN ~ -SYN ; 00088800 LL32: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00088900 BEGIN 00089000 RN ~ A[I,J]|KOS + A[I,K]|SYN ; 00089100 BE ~ -A[I,J]|SYN + A[I,K]|KOS ; 00089200 A[I,J] ~ RN ; 00089300 A[I,K] ~ BE 00089400 END 00089500 END ; 00089600 LL31: END ; 00089700 GO TO LL29 ; 00089800 LL30: FOR I ~ 1 STEP 1 UNTIL NVAR DO 00089900 FOR J ~ 1 STEP 1 UNTIL NRO DO 00090000 A[I,J] ~ A[I,J]|SUMX[I] ; 00090100 EX ~ II - 2 ; 00090200 WRITE(PRINT,FRM18,NRO,EX) ; 00090300 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00090400 WRITE(PRINT,FRM13,ROTM) ; 00090500 WRITE(PRINT,FRM19) ; 00090600 IF PNCH = 1 THEN 00090700 BEGIN 00090800 FOR I~1 STEP 1 UNTIL NVAR DO 00090900 WRITE(PUNCH,PUNCHOUT,ROTM); 00091000 END; 00091100 FOR I ~ 2 STEP 1 UNTIL II DO 00091200 BEGIN 00091300 EX ~ I - 2 ; 00091400 WRITE(PRINT,FRM20,EX,DATA[I]) 00091500 END ; 00091600 WRITE(PRINT,FRM21) ; 00091700 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00091800 BEGIN 00091900 SUMX[I] ~ SUMX[I]|SUMX[I] ; 00092000 BE ~ 0.0 ; 00092100 FOR J ~ 1 STEP 1 UNTIL NRO DO 00092200 BE ~ BE + A[I,J]|A[I,J] ; 00092300 RN ~ BE - SUMX[I] ; 00092400 WRITE(PRINT,FRM22,I,SUMX[I],BE,RN) 00092500 END 00092600 END 00092700 END 00092800 END ; 00092900 GO TO START ; 00093000 WRONGCOUNT: WRITE(LINE, ERRCNT); 00093100 NOMO: DATELINE(0); 00093200 END. 00093300