BEGIN 00000000 COMMENT CORMISD/STATMAN JAN 21,1969; 00000100 COMMENT 00000200 MAKMAST/MISDAT PROPARES A TAPE "MASTER" OF ALL THE DATA IT READS FROM 00000300 CARDS. ANY MISSING DATA - BLANKS - ON CARD ARE REPLACED BY "NULL". 00000400 ONE TO SIX DIGIT FIELDS ARE ALLOWED (A6). A REPLACABLE FORMAT CARD 00000500 SPECIFIES THE CARD DATA FORMAT. ALL THE FIELDS MUST BE READ AS 00000600 ALPHA (IE. A4) TO FIND THE BLANKS. AFTER "MASTER" HAS BEEN PREPARED 00000700 AND HAS BEEN REWOUND THE PROGRAM IS NEXT DESIGNED TO COMPUTE THE N, 00000800 SUM XSQ, SUM YSQ, SUM Y, SUM X, AND SUMXY FOR UP TO 1023 SCORES (NVAR) 00000900 AND AS MANY CASES (NCASE) AS WILL FIT ON ONE MAGNETIC TAPE. THE PROGRAM00001000 WILL ACCEPT DATA FROM TAPE (FILE "MASTER") WHICH CONTAINS ONE CASE OR 00001100 SUBJECT PER RECORD (NO BLOCKING FACTOR) AND ONE VARIABLE OR SCORE PER 00001200 COMPUTER WORD (FLT.PT.BINARY), THEREFORE 65 SCORES AND 500 CASES WILL 00001300 BE CONTAINED ON A TAPE COMPOSED OF 500 RECORDS (NO BLOCKING) AND 65 00001400 WRDS/REC. A MISSING SCORE IS INDICATED BY THE CHARACTERS "NULL" 00001500 (45644343-RIGHT JUSTIFIED ) IN THE PLACE OF A SCORE. ANY "NULL" SCORE 00001600 IS NOT CONSIDERED IN THE CORRELATION. PARTITIONING OF THE MATRIX IS 00001700 AUTOMATIC AND IS DEPENDENT ON THE AMOUNT OF MEMORY AVAILABLE (MEM) 00001800 AND THE NUMBER OF VARIABLES (NVAR). THE PARTITIONING FACTOR (NPART) 00001900 IS INDEPENDENT OF THE NUMBER OF CASES. NPART THE DETERMINES THE NUMBER 00002000 OF TAPE PASSES REQUIRED TO FORM ALL THE SUMS AFTER EACH PASS OF "MASTER"00002100 THE COMPUTED SUMS ARE WRITTEN ONTO TAPE "SUMS" UNTIL ALL SUMS ARE 00002200 FORMED. IT IS THEN NECESSARY TO REARRANGE THE SUMS AND WRITE THEM 00002300 ONTO TAPE ARR OR ARR1 (7 WRDS/REC). THE FIRST WORD OF EACH RECORD IS 00002400 USED INTERNALLY WITHIN THE PROGRAM. WHEN REARRANGING IS FINISHED 00002500 (PERFORMED IN THE INNER BLOCK) THE RESULTS ARE PRINTED (TWOTAPE PASSES 00002600 REQ.). 00002700 FOR RETART PURPOSES THE PROGRAM HAS BEEN BROKEN INTO 5 PHASES 00002800 DESCRIBED BELOW: 00002900 00003000 PHASE 0 - INITIAL STARTING OF THE PROGRAM, DATA COMES FROM 00003100 FILE "MASTER". (FILE PROTECT THIS TAPE) 00003200 00003300 PHASE 1 - THIS PHASE IS ENTERED ANY TIME AFTER FILE SUMS 00003400 IS OPENED. THIS PHASE READS MASTER AND WRITES SUMS.00003500 A CARD IS PUNCHED AT THE END OF EVERY TAPE WRITE FOR FILE "SUMS" 00003600 (EXCEPT THE LAST ONE). THE PUNCH IS THEN CLOSED AND REOPENED WHEN 00003700 WHEN AGAIN NEEDED. THE CARD THAT IS PUNCHED IS REQUIRED FOR ANY RESTART00003800 DURING PHASE 1 AND INDICATES TO THE PROGRAM WHERE FILE "SUMS" MUST BE 00003900 POSITIONED. THIS CARD ALONG WITH ITS "LABEL" AND "EOF" CARD MUST FOLLOW00004000 THE "EOF" CARD THAT FOLLOWS THE STANDARD INPUT CARD. IF A RESTART 00004100 IS MADE DURING ANY OTHER PHASE, THAN THIS SECOND CARD IS NOT REQUIRED. 00004200 IF NO CARD(S) IS PUNCHED THAN "NPART" EQUALS 1. IF "NPART" > 1 00004300 THEN (NPART-1) CARDS WILL BE PUNCHED (WITH THE PUNCH FILE OPENED 00004400 AND CLOSED FOR EACH CARD). 00004500 THE LAST CARD PUNCHED SHOULD BE USED IN A RESTART DURING PHASE 1 00004600 ALTHO, ANY OF THE PREVIOUSLY PUNCHED CARDS WOULD ALSO WORK . 00004700 00004800 PHASE 2 - ENTERED AFTER EOT MESSAGE GIVEN FOR SUMS. FILES 00004900 ARR AND/OR ARR1 ARE THEN OPENED. 00005000 FILE SUMS IS LOCKED AND THE 00005100 WRITE RING MUST BE PULLED BEFORE PROCEEDING (SAFETY 00005200 PRECAUTION). THIS PHASE READ SUMS AND WRITES ARR 00005300 AND/OR ARR1. 00005400 ONE PASS IS MADE ON FILE "MASTER" SO THAT THE 00005500 DIAGNAL ELEMENTS MAY BE FORMED - "MASTER" MAY 00005600 THEN BE REMOVED. (FOR A PHASE 2 RESTART) 00005700 (ALSO ON A PHASE 2 RESTART IT IS NECESSARY TO 00005800 PURGE FILES ARR AND/OR ARR1, IF OPENED) 00005900 00006000 PHASE 3 - ENTERED AFTER FILE ARR OR ARR1 IS LOCKED. REMOVE 00006100 WRITE RING-AS PER SPO MESSAGE-TO PROCEED. SUM XY, 00006200 N, ETC IS READ FROM TAPE AND PRINTED FOR ALL 00006300 COMBINATIONS. 00006400 00006500 PHASE 4 - ENTERED AFTER ALL SUMS HAVE BEEN PRINTED (IDENTITY 00006600 MATRIX IS LAST ONE PRINTED). MEANS, STANDARD 00006700 DEVIATION, ETC IS NOW COMPUTED AND PRINTED BY MAKING00006800 AN ADDITIONAL PASS OF TAPE ARR OR ARR1. 00006900 00007000 ONE DATA CARD OF THE FOLLOWING FORMAT IS READ: 00007100 (ALL COLUMN NUMBERS ARE INCLUSIVE) 00007200 ** CARD 1 ** 00007300 00007400 00007500 COLS 1-72 IDENTIFICATION INFORMATION OF YOUR CHOICE TO BE 00007600 USED IN TITLE. 00007700 00007800 00007900 ** CARD 2 ** 00008000 00008100 00008200 1 COLS 1-5 NUMBER OF VARIABLES (WRDS/REC) RIGHT JUSTIFIED 00008300 00008400 2 COLS 6-10 NUMBER OF SUBJECTS (NO OF RECORDS) RIGHT JUSTIFIED 00008500 00008600 3 COL 15 PRNT - IF YOU WANT THE DATA INPUT TO BE PRINTED 00008700 PUNCH 1 YES 00008800 BLANK OTHERWISE 00008900 00009000 4 COLS 20 PRINTORNOT - IF YOU WANT THE SUM X,Y, X*2, Y*2, XY 00009100 PRINTED 00009200 PUNCH 1 YES 00009300 BLANK OTHERWISE 00009400 00009500 5 COLS 26-30 CORROUT - IF YOU WANT TAPE "CORMAT" CREATED WITH YOUR00009600 FULL CORRELATION MATRIX OUTPUT 00009700 PUNCH TRUE WANT "CORMAT" 00009800 BLANK OTHERWISE 00009900 00010000 6 COL 31 RESTART NUMBER (0,1,2,3 OR 4) 00010100 00010200 7 COL 32-35 I (RIGHT JUSTIFIED) A NONZERO INDICATES THAT ONLY 00010300 ALL I, J COMBINATIONS WILL BE FORMED AND PRINTED FOR 00010400 HELD CONSTANT AND J=I, ... NVAR (NO. OF VARIABLES) 00010500 NAMELY, IF THIS FIELD CONTAINS A 35 THEN COMBINATIONS00010600 35,35 35,36 35,37 35,38........35,NVAR-1, 35,NVAR 00010700 ARE FORMED AND PRINTED. THIS FIELD AND COLS 36-39 00010800 MAY NOT BOTH BE NONBLANK ON THE SAME RUN. THIS 00010900 OPTION IS IGNORED IF THE FIELD IS BLANK OR ZERO. 00011000 00011100 8 COLS 36-39 J (RIGHT JUSTIFIED). A NONZERO INDICATES THAT ONLY 00011200 ALL I, J COMBINATIONS WILL BE FORMED FOR J HELD 00011300 CONSTANT AND I=1,2....J. NAMELY, IF THIS FIELD 00011400 CONTAINS A 35 THE COMBINATIONS 1,35 2,353,35 4,35 .. 00011500 ... 34,35 35,35 ARE COMPUTED AND RESULTS PRINTED. 00011600 IF THIS FIELD IS BLANK OR A 1 THEN THE STANDARD 00011700 CORRELATION FOR ALL COMBINATIONS ARE COMPUTED. 00011800 RESTART NUMBER IS IGNORED IF THIS FIELD IS NONBLANK. 00011900 THIS FIELD AND COLS 32-35 MAY NOT BOTH BE NONBLANK 00012000 THE SAME RUN. 00012100 00012200 ******* OPTIONS 7 AND 8 ARE PRIMARILY PROVIDED FOR DATA 00012300 ******* DEBUGING INCASE CERTAIN SCORES ARE THOUGHT TO BE IN 00012400 ******* ERROR 00012500 00012600 AFTER ITEMS 1,2 HAVE BEEN ESTABLISHED THEY MAY NOT BE CHANGED 00012700 ON ANY RESTART. 00012800 ITEM 4 MAY BE CHANGED ON ANY RESTART. IF COL 20 IS BLANK AND 00012900 PHASE 3 IS INDICATED ON THE RESTART CARD, THEN PHSAE 3 00013000 IS PRINTED ANYWAY. FOR A RESTART NUMBER OF 0,1, OR 2 AND 00013100 ITEM 4 NONBLANK THEN PHASE 3 IS NOT PRINTED. 00013200 APPROX. RUNNING TIME FOR A PROBLEM OF 500 CASES AND 112 VARIABLES 00013300 IS 1 HOUR AND 30 MIN. PHASES 0,1, AND 2 ARE COMPUTE BOUND AND RAN 00013400 FOR ABOUT 1 HOUR AND 10 MIN, PHASES 3 AND 4 ARE PRINT BOUND AND ACCOUNT00013500 FOR THE REMAINDER OF THE TIME. 00013600 R.J.HAM - BURROUGHS CORP. ; 00013700 00013800 00013900 FILE IN CARD(2,10); 00014000 FILE OUT LINE 4(2,15); 00014100 LABEL FINIS; 00014200 INTEGER NVAR,N,I,S; 00014300 REAL ARRAY TITLE[0:11]; 00014400 INTEGER NSUBJ, CSUBJ, PRNT; 00014500 BOOLEAN CORROUT; 00014600 INTEGER PRINTORNOT; 00014700 INTEGER RSTT; 00014800 INTEGER ELEMNO; 00014900 INTEGER ELEMN; 00015000 LIST LPAR(FOR I~0 STEP 1 UNTIL 11 DO TITLE[I],NVAR,NSUBJ, 00015100 PRNT,PRINTORNOT,CORROUT,RSTT,ELEMN,ELEMNO); 00015200 FORMAT FERR(//"**********ERROR**********"//"THE NUMBER OF SUBJE"00015300 ,"CT CARDS THAT WERE COUNTED DOES NOT EQUAL THE EXPECTED"00015400 ," NUMBER INDICATED ON THE PARAMETER CARD."/"THUS THE PR"00015500 ,"OGRAM HAS BEEN ENDED. TAPE * MASTER * SHOULD BE RECREA"00015600 ,"TED WITH THE CORRECT NUMBER OF SUBJECTS."); 00015700 FORMAT FPAR(12A6/2I5,X4,I1,X1,A4,X5,L5,I1,2I4); 00015800 FORMAT PFPAR (X24, 12A6 // 00015900 X41, "NUMBER OF VARIABLES .......... ", I7 / 00016000 X41, "NUMBER OF SUBJECTS ........... ", I7 / 00016100 X41, "PRINT MASTER TAPE ............ ", X5,A3/ 00016200 X41, "PRINT SUM X, Y, X2, Y2, XY ... ",X5,A3/ 00016300 X41, "CORMAT WRITTEN ............... ",X3,L5/); 00016400 LIST PLPAR(FOR I~0 STEP 1 UNTIL 11 DO TITLE[I],NVAR,NSUBJ, 00016500 IF PRNT=1 THEN "YES" ELSE " NO", IF PRINTORNOT=1 THEN 00016600 "YES" ELSE " NO",CORROUT); 00016700 FORMAT SUBCNT (X41, "COMPUTER-COUNTED SUBJECTS .... ", I7 //); 00016800 LIST LSUB (CSUBJ); 00016900 PROCEDURE OBJECTFMTGEN(INFORMAT);FORMAT INFORMAT;BEGIN OWN REAL NCR,NFWD00017000 ,ELCLASS;OWN REAL LCR;OWN INTEGER CNT,TCNT,RSLT,F;OWN INTEGER FMAX;OWN R00017100 EAL ARRAY ACCUM[0:9];SAVE OWN REAL ARRAY GENF[0:259];SAVE OWN REAL ARRAY00017200 IMAG[0:9];OWN REAL ARRAY PRNT[0:19];OWN BOOLEAN ERRTOG;LABEL FINISHED;S00017300 TREAM PROCEDURE TATTLE(F,LINE);VALUE F;BEGIN SI~LOC F;DI~LINE;10(DS~LIT"00017400 ");DS~9LIT"FMT SIZE ";DS~3DEC;DS~4LIT" WDS";47(DS~2LIT" ");END OF TATT00017500 LE;PROCEDURE FLAG(ERRNUM);INTEGER ERRNUM;BEGIN STREAM PROCEDURE INSERT(E00017600 RR,LINE,ACCUM,CNT);VALUE ERR,CNT;BEGIN SI~LOC ERR;DI~LINE;10(DS~LIT"X");00017700 DS~16LIT" SYNTAX ERROR #";DS~3DEC;DS~4LIT" ..";SI~ACCUM;SI~SI+3;DS~CNT00017800 CHR;DS~4LIT".. ";10(DS~LIT"X");36(DS~2LIT" ");END OF INSERT;INSERT(ER00017900 RNUM,PRNT[0],ACCUM[1],CNT);WRITE(LINE,15,PRNT[*]);ERRTOG~TRUE;END OF FLA00018000 G;PROCEDURE ERR(ERRNUM);INTEGER ERRNUM;BEGIN FLAG(ERRNUM);END;REAL STREA00018100 M PROCEDURE SETUP(CARD,LINE,LCR);BEGIN LOCAL SET1;SI~CARD;DI~LINE;DS~10W00018200 DS;40(DS~2LIT" ");SI~CARD;SET1~SI;DI~LOC SETUP;SI~LOC SET1;DS~WDS;DI~CA00018300 RD;9(DI~DI+8);SET1~DI;DS~LIT"%";SI~LOC SET1;DI~LCR;DS~WDS;END OF SETUP;R00018400 EAL STREAM PROCEDURE FMTF(FMTIN);BEGIN LOCAL ST;SI~FMTIN;DI~LOC FMTF;ST~00018500 SI;SI~LOC ST;DS~WDS;END OF FMTF;REAL STREAM PROCEDURE EXAMIN(NCR);VALUE 00018600 NCR;BEGIN SI~NCR;DI~LOC EXAMIN;DI~DI+7;DS~CHR;END OF EXAMIN;REAL STREAM 00018700 PROCEDURE CONV(ACCUM,SKP,N);VALUE SKP,N;BEGIN SI~ACCUM;SI~SI+SKP;SI~SI+300018800 ;DI~LOC CONV;DS~N OCT;END OF CONV;REAL PROCEDURE CONVERT;BEGIN REAL T;IN00018900 TEGER N;T~CONV(ACCUM[1],TCNT,N~(CNT-TCNT)MOD 8);FOR N~TCNT+N STEP 8UNTIL00019000 CNT-1DO T~T|100000000+CONV(ACCUM[1],N,8);CONVERT~T;END OF CONVERT;STREA00019100 M PROCEDURE SCAN(NCRV,NCR,ACCUM,CNT,CNTV,RSLT,RSLTV,AC);VALUE NCRV,CNTV,00019200 RSLTV,AC;BEGIN LOCAL ST1,ST2;LABEL DEBLANK,GETCHR,NUMBER,EXIT,FINIS;LABE00019300 L L;SI~NCRV;DI~RSLT;DI~DI+7;CI~CI+RSLTV;GO TO FINIS;GO TO FINIS;GO TO FI00019400 NIS;GO TO NUMBER;GO TO FINIS;GO TO GETCHR;GO TO FINIS;DEBLANK:IF SC=" "T00019500 HEN BEGIN L:SI~SI+1;IF SC=" "THEN GO TO L;END;GO TO FINIS;GETCHR:DS~LIT"00019600 2";TALLY~1;SI~SI+1;GO TO EXIT;NUMBER:TALLY~63;DS~LIT"3";AC(TALLY~TALLY+100019700 ;IF SC<"0"THEN JUMP OUT TO EXIT;SI~SI+1);EXIT:ST1~TALLY;TALLY~TALLY+CNTV00019800 ;ST2~TALLY;DI~CNT;SI~LOC ST2;DS~WDS;DI~ACCUM;SI~SI-3;DS~3CHR;DI~DI+CNTV;00019900 SI~NCRV;DS~ST1 CHR;FINIS:DI~NCR;ST1~SI;SI~LOC ST1;DS~WDS;END OF SCAN;PRO00020000 CEDURE READACARD;BEGIN READ(CARD,10,IMAG[*]);NCR~SETUP(IMAG[0],PRNT[0],L00020100 CR);WRITE(LINE,15,PRNT[*]);END OF READACARD;PROCEDURE SCANNER;BEGIN LABE00020200 L L;L:SCAN(NCR,NCR,ACCUM[1],CNT,CNT,RSLT,RSLT,63-CNT);IF NCR=LCR THEN BE00020300 GIN READACARD;GO TO L;END;END OF SCANNER;PROCEDURE NEXTENT;BEGIN CNT~ACC00020400 UM[1]~0;IF EXAMIN(NCR)=" "THEN BEGIN RSLT~7;SCANNER;END DEBLANK;IF EXAMI00020500 N(NCR){9THEN BEGIN RSLT~3;SCANNER;TCNT~0;IF CNT>4THEN FLAG(140)ELSE IF E00020600 LCLASS~-CONVERT<-1023THEN FLAG(140)END ELSE BEGIN RSLT~5;SCANNER;ELCLASS00020700 ~ACCUM[1].[18:6];END;END OF NEXTENT;STREAM PROCEDURE MOVECODE(TEMP,FINAL00020800 ,RPT,REM);VALUE RPT,REM;BEGIN LOCAL ST1;SI~TEMP;DI~FINAL;DS~REM WDS;ST1~00020900 SI;SI~LOC RPT;SI~SI+7;IF SC!"0"THEN BEGIN SI~ST1;RPT(DS~63WDS);END;END O00021000 F MOVECODE;PROCEDURE MAXWDS(INFORMAT);FORMAT INFORMAT;BEGIN OWN INTEGER 00021100 CTR,FLG;LABEL RETURN,EX;INTEGER STREAM PROCEDURE WDCTR(FMT,CTR,FLG);VALU00021200 E CTR;BEGIN LOCAL ST1;LABEL SCAN,FND,EXIT;SI~LOC CTR;SI~SI+7;DI~LOC ST1;00021300 DS~4LIT"0000";DI~DI-4;IF SC="0"THEN BEGIN SI~FMT;GO TO SCAN;END;SI~FMT;C00021400 TR(63(SI~SI+8));SCAN:63(IF 4SC=DC THEN JUMP OUT TO FND;TALLY~TALLY+1;DI~00021500 DI-4;SI~SI+4);ST1~TALLY;GO TO EXIT;FND:ST1~TALLY;SI~SI-4;DI~FLG;DS~WDS;E00021600 XIT:SI~LOC ST1;DI~LOC WDCTR;DS~WDS;END OF WDCTR;FMAX~CTR~FLG~0;RETURN:FM00021700 AX~FMAX+WDCTR(INFORMAT,CTR,FLG);IF FLG!0THEN GO TO EX;CTR~CTR+1;GO TO RE00021800 TURN;EX:END OF MAXWDS;STREAM PROCEDURE LARGER(LINE,F);VALUE F;BEGIN SI~L00021900 OC F;DI~LINE;10(DS~LIT"X");DS~41LIT" FORMAT TOO LARGE (RECEIVER FMT SIZ00022000 E IS ";DS~3DEC;DS~9LIT" WORDS) ";10(DS~LIT"X");47(DS~LIT" ");END OF LAR00022100 GER;PROCEDURE GETINT;BEGIN NEXTENT;IF ELCLASS~-ELCLASS<0THEN BEGIN FLAG(00022200 137);ELCLASS~0END END GETINT;INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2);VALU00022300 E NUMBER;INTEGER P1,P2,NUMBER;BEGIN IF NUMBER<0THEN BEGIN FLAG(138);NUMB00022400 ER~0END;P1~IF NUMBER<8THEN NUMBER ELSE 8;NUMBER~NUMBER-P1;P2~IF NUMBER<800022500 THEN NUMBER ELSE 8;DIVIDE~NUMBER-P2 END DIVIDE;STREAM PROCEDURE WHIPOUT(00022600 NFWDV,W,NFWD);VALUE NFWDV;BEGIN LOCAL ST;SI~W;DI~NFWDV;DS~WDS;ST~DI;DI~N00022700 FWD;SI~LOC ST;DS~WDS;END OF WHIPOUT;BOOLEAN PROCEDURE FORMATPHRASE;BEGIN00022800 LABEL EL,EX,EXIT,L1,L2,L3;PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,00022900 W2,D1,D2);VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2;REAL CODE,REPEAT,SKIP,W00023000 ,W1,W2,D1,D2;BOOLEAN S;BEGIN IF W>63THEN FLAG(163);W~REPEAT&W[6:42:6]&SK00023100 IP[32:42:6]&W1[28:44:4]&W2[24:44:4]&D1[20:44:4]&D2[16:44:4]&CODE[2:44:4]00023200 &REAL(S)[1:47:1];F~F+1;WHIPOUT(NFWD,W,NFWD);END EMITFORMAT;STREAM PROCED00023300 URE PACKALPHA(PLACE,LETTER,CTR);VALUE LETTER,CTR;BEGIN DI~PLACE;DS~LIT"B00023400 ";SI~LOC CTR;SI~SI+7;DS~CHR;SI~PLACE;SI~SI+3;DS~5CHR;SI~LOC LETTER;SI~SI00023500 +7;DS~CHR END PACKALPHA;INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE;BOOLEAN S00023600 ;INTEGER ST;DEFINE RRIGHT=0#,RLEFT=4#,RSTROKE=6#;DEFINE RSCALE=8#,RR=15#00023700 ;DEFINE RD=0#,RX=2#,RA=4#,RI=6#,RF=8#,RE=10#,RO=12#,RL=14#;IF ELCLASS<0T00023800 HEN BEGIN REPEAT~-ELCLASS;NEXTENT;IF ELCLASS=","THEN GO EX END ELSE REPE00023900 AT~REAL(ELCLASS!"("AND ELCLASS!"<");IF ELCLASS="("OR ELCLASS="<"THEN BEG00024000 IN SKIP~F;EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0);DO BEGIN NEXTENT;EL:00024100 IF FORMATPHRASE THEN GO TO EX END UNTIL ELCLASS!",";WHILE ELCLASS="/"DO 00024200 BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0);NEXTENT END;IF ELCLASS!")"A00024300 ND ELCLASS!">"THEN GO TO EL;IF REPEAT=0THEN EMITFORMAT(TRUE,RSTROKE,1,0,00024400 0,0,0,0,0);S~TRUE;REPEAT~F-SKIP;CODE~RRIGHT END ELSE IF ELCLASS="O"THEN 00024500 BEGIN CODE~RO;W~8END ELSE IF ELCLASS="D"THEN BEGIN CODE~RD;W~8END ELSE I00024600 F ELCLASS=","THEN GO TO L2 ELSE IF ELCLASS="/"THEN GO TO EXIT ELSE IF EL00024700 CLASS=")"OR ELCLASS=">"THEN GO TO EXIT ELSE IF ELCLASS="S"THEN BEGIN NEX00024800 TENT;W~IF ELCLASS="-"THEN 1ELSE 0;IF ELCLASS>0THEN NEXTENT;IF ELCLASS>0T00024900 HEN BEGIN ERR(136);GO TO EXIT END ELSE REPEAT~-ELCLASS;EMITFORMAT(TRUE,R00025000 SCALE,REPEAT,0,W,0,0,0,0);GO TO L2 END ELSE IF ELCLASS="""THEN BEGIN COD00025100 E~100;ST~0;DO BEGIN SKIP~1;DO BEGIN RSLT~5;CNT~0;SCANNER;IF ELCLASS~ACCU00025200 M[1].[18:6]=CODE THEN BEGIN IF SKIP!1THEN BEGIN WHIPOUT(NFWD,W,NFWD);F~F00025300 +1;END;GO TO L2 END;CODE~""";PACKALPHA(W,ELCLASS,SKIP);END UNTIL SKIP~SK00025400 IP+1=7;WHIPOUT(NFWD,W,NFWD);F~F+1;END UNTIL(ST~ST+6)>132;GO TO EX END EL00025500 SE BEGIN CODE~ELCLASS;GETINT;W~ELCLASS;IF CODE="I"THEN BEGIN SKIP~DIVIDE00025600 (W,W1,W2);CODE~RI END ELSE IF CODE="F"THEN BEGIN CODE~RF;GO TO L1 END EL00025700 SE IF CODE="R"THEN BEGIN CODE~RR;GO TO L1 END ELSE IF CODE="E"THEN BEGIN00025800 CODE~RE;D1~1;L1:NEXTENT;IF ELCLASS!"."THEN GO TO EX;GETINT;IF DIVIDE(EL00025900 CLASS+D1,D1,D2)>0THEN GO TO EX;IF CODE=RF OR CODE=RR THEN SKIP~DIVIDE(W-00026000 ELCLASS-1,W1,W2)ELSE IF SKIP~W-ELCLASS-6<0THEN GO TO EX END ELSE IF CODE00026100 ="X"THEN BEGIN CODE~RX;W1~W.[38:4];SKIP~W~W.[42:6]END ELSE IF CODE="A"TH00026200 EN BEGIN CODE~RA;W1~6;GO TO L3 END ELSE IF CODE="L"THEN BEGIN CODE~RL;W100026300 ~5;L3:IF W200;F~@40*2;END;ERRTOG~FORMATPHR00026800 ASE;IF ELCLASS=";"THEN GO TO FINISHED;FLAG(119);FINISHED:TATTLE(F,PRNT[000026900 ]);WRITE(LINE,15,PRNT[*]);MAXWDS(INFORMAT);IF F>FMAX THEN BEGIN LARGER(P00027000 RNT[0],FMAX);WRITE(LINE,15,PRNT[*]);ERRTOG~TRUE;END;NCR~0&(F+1)[24:39:9]00027100 ;WHIPOUT(NFWD,NCR,NFWD);CNT~(F+1)DIV 63;TCNT~(F+1)MOD 63;IF ERRTOG THEN 00027200 BEGIN NCR~TIME(1);DO F~0UNTIL TIME(1)-NCR>200;F~@40*2;END;MOVECODE(GENF,00027300 INFORMAT,CNT,TCNT);END OF OBJECTFMTGEN; 00027400 PROCEDURE DATELINE(PROGRAM);VALUE PROGRAM;ALPHA PROGRAM;BEGIN OWN BOOLEA00027500 N USED;FORMAT HD(A4,I3,", ",A4,X2,"TIME:",I5,X10,"OUTPUT FROM PROGRAM ",00027600 A6,X10,"UNIVERSITY OF DENVER COMPUTING CENTER"///),LAYT(//"EXECUTION TIM00027700 E =",I5,X03,"I/O TIME =",I5," SECONDS ",A4,I3,", ",A4,X03,"TIME:",I7///00027800 );LABEL GOTIT;ALPHA MO,MINS,FEB,HRS,YR,DAY;USED~USED AND PROGRAM.[18:6]=00027900 0;DAY~TIME(0);YR~DAY.[18:12]+"1900";DAY~DAY.[42:6]+10|DAY.[36:6]+100|DAY00028000 .[30:6];FEB~IF YR.[42:6]MOD 4=0 THEN"(FEB."ELSE"&FEB.";FOR MO~"~JAN.",FE00028100 B,"~MAR.","1 THEN ELEMENTS FORMED ONLY ONCE; 00047800 IF ONCE THEN FOR M~0 STEP 1 UNTIL NVAR1 DO 00047900 IF SCORE[M]! NULL THEN DIAG(DIAGN[M,*]); 00048000 FOR I~ LLIM STEP 1 UNTIL ULIM DO 00048100 IF SCORE[I] ! NULL THEN 00048200 ROW(NYSQ[I,*],XSQY[I,*],XXY[I,*] ); 00048300 END; 00048400 FOR K ~ LLIM STEP 1 UNTIL ULIM DO 00048500 WRITE(SUMS,NVAR,XSQY[K,*]) ; 00048600 FOR K ~ LLIM STEP 1 UNTIL ULIM DO 00048700 WRITE(SUMS,NVAR,NYSQ[K,*]); 00048800 FOR K ~ LLIM STEP 1 UNTIL ULIM DO 00048900 WRITE(SUMS,NVAR,XXY[K,*]); 00049000 L1: 00049100 IF NP !NPART THEN 00049200 BEGIN 00049300 WRITE(PUNCH,FER,NP); 00049400 CLOSE(PUNCH,RELEASE); 00049500 NP~NP+1; 00049600 ONCE~FALSE; 00049700 DIR ~ NOT DIR ; 00049800 LLIM ~ PARTIT[NP|2-1] ; 00049900 ULIM ~ PARTIT[NP|2] ; 00050000 GO TO L ; 00050100 END; 00050200 END INNER BLOCK ; 00050300 END ; COMMENT END PROCEDURE CORR; 00050400 PROCEDURE ONECOMB; 00050500 BEGIN 00050600 ARRAY NN,XSQ,X,YSQ,Y,XY[0:NVAR1 ]; 00050700 REAL XT,T1,T2; 00050800 INTEGER N; 00050900 REAL DUMMY,SUMY,SUMYSQD,SUMXY,SUMXSQD,SUMX, 00051000 CORR,MEANX,MEANY,SIGMAX,SIGMAY; 00051100 LIST LST2 (I,J,CORR,N,MEANX,MEANY,SIGMAX,SIGMAY); 00051200 LIST LST3 (J,I,CORR,N,MEANY,MEANX,SIGMAY,SIGMAX); 00051300 FORMAT OUT FMT1 (X2,"IDENT",X8,"CORR",X9,"N",X11,"MEAN (X)", 00051400 X12,"MEAN (Y)",X11,"SIGMA (X)",X11, 00051500 "SIGMA (Y)"//); 00051600 FORMAT OUT FMT2 (I4,X1 ,I4,X4,F7.4,X6,I4,X7,F13.4,X7,F13.4, 00051700 X7,F13.4,X7,F13.4 ); 00051800 LABEL L; 00051900 BOOLEAN B; 00052000 COMMENT THIS PROCEDURE COMPUTES AND PRINTS ALL COMBINATIONS OF I,J FOR 00052100 EITHER I HELD CONSTANT AND J=I,...NVAR OR FOR J HELD CONSTANT 00052200 AND I=1,2,....J. OPTION COMES FROM THE INPUT CARD. "MASTER" IS 00052300 READ AND ALL COMBINATIONS ARE FORMED AND PRINTED (ALL 00052400 COMBINATIONS ARE RETAINED IN MEMORY; 00052500 ELEMN~ELEMN-1; 00052600 IF ELEMN}0 THEN 00052700 BEGIN 00052800 LLIM~ELEMN; ULIM~NVAR1; B~FALSE; 00052900 ELEMNO~ELEMN; 00053000 END ELSE 00053100 BEGIN 00053200 LLIM~0; ULIM~ELEMNO; B~TRUE; 00053300 END; 00053400 I~ELEMNO; 00053500 TOP~0; 00053600 FOR K~ 1 STEP 1 UNTIL NCASE DO 00053700 BEGIN 00053800 READ(MASTER,NVAR,SCORE[*]); 00053900 IF SCORE[I] ! NULL THEN 00054000 BEGIN 00054100 T2~SCORE[I]; 00054200 FOR J~LLIM STEP 1 UNTIL ULIM DO 00054300 IF SCORE[J] ! NULL THEN 00054400 BEGIN 00054500 T1~SCORE[J]; 00054600 NN[J]~NN[J]+1; XSQ[J]~T1*2+XSQ[J]; X[J]~T1+X[J]; 00054700 YSQ[J]~T2*2+YSQ[J]; Y[J]~Y[J]+T2; XY[J]~XY[J]+T1|T2; 00054800 END; 00054900 END; 00055000 END; 00055100 CLOSE(MASTER,SAVE); 00055200 J~ELEMNO+1; WRITE(LINE,HED); 00055300 FOR I~LLIM STEP 1 UNTIL ULIM DO 00055400 BEGIN 00055500 IF B THEN 00055600 WRITE(LINE,FM,I+1,J,X[I],XSQ[I],Y[I],YSQ[I],XY[I],NN[I]) 00055700 ELSE 00055800 WRITE(LINE,FM,J,I+1,Y[I],YSQ[I],X[I],XSQ[I],XY[I],NN[I]);00055900 TOP~TOP+1; 00056000 IF TOP>54 THEN 00056100 BEGIN 00056200 WRITE(LINE[PAGE]); 00056300 WRITE(LINE,HED); 00056400 TOP~0; 00056500 END; 00056600 END; 00056700 J~ELEMNO+1; 00056800 WRITE(LINE[PAGE]); WRITE(LINE,FMT1); 00056900 TOP~0; 00057000 FOR M~LLIM STEP 1 UNTIL ULIM DO 00057100 BEGIN 00057200 N~NN[M]; SUMY~Y[M]; SUMYSQD~YSQ[M]; SUMXY~XY[M]; 00057300 SUMXSQD~XSQ[M]; SUMX~X[M]; 00057400 IF N = 0 THEN 00057500 BEGIN 00057600 MEANX~MEANY~SIGMAX~SIGMAY~CORR~0; GO TO L; 00057700 END; 00057800 MEANY ~ SUMY / N; MEANX ~ SUMX / N; 00057900 SIGMAX ~ SQRT ((SUMXSQD / N) - (MEANX * 2)); 00058000 SIGMAY ~ SQRT ((SUMYSQD / N) - (MEANY * 2)); 00058100 XT~SUMXY-(SUMX | SUMY)/N; 00058200 T1~SUMXSQD - (SUMX*2)/N; 00058300 T2~SUMYSQD-(SUMY*2)/N; 00058400 IF T1=0 OR T2=0 THEN CORR~0 ELSE 00058500 CORR~XT/(SQRT(T1) | SQRT(T2)); 00058600 I~M+1; 00058700 L: 00058800 IF B THEN 00058900 WRITE(LINE,FMT2,LST2) 00059000 ELSE 00059100 WRITE(LINE,FMT2,LST3); 00059200 TOP~TOP+1; 00059300 IF TOP>54 THEN 00059400 BEGIN 00059500 WRITE(LINE[PAGE]); WRITE(LINE,FMT1); 00059600 TOP~0 00059700 END; 00059800 END; 00059900 GO TO STP; 00060000 END ONECOMB; 00060100 COMMENT STO COL. NOS. FOR PARTITIONED MATRIX IN PARTIT ; 00060200 NULL ~ "NULL"; 00060300 IF ELEMN}1 OR ELEMNO>0 THEN ONECOMB; 00060400 ONCE~TRUE; 00060500 TEMP ~ NPART | 2; 00060600 PARTIT[1] ~ 0; 00060700 PARTIT[2] ~ (NVAR DIV NPART) -1 ; 00060800 REM ~ NVAR MOD NPART ; 00060900 FOR I ~ 3 STEP 2 UNTIL TEMP DO 00061000 BEGIN 00061100 PARTIT[I] ~ PARTIT[I-1] + 1; 00061200 PARTIT[I+1] ~ PARTIT[2] + PARTIT[I] ; 00061300 END; 00061400 IF REM ! 0 THEN PARTIT[I-1] ~ PARTIT[I-1] + REM; 00061500 DIR ~ TRUE; 00061600 NP ~ 1 ; 00061700 IF RSTT = 2 THEN 00061800 BEGIN 00061900 FOR K~1 STEP 1 UNTIL NCASE DO 00062000 BEGIN 00062100 READ(MASTER,NVAR,SCORE[*]); 00062200 FOR M~0 STEP 1 UNTIL NVAR1 DO IF SCORE[M]!NULL 00062300 THEN DIAG(DIAGN[M,*]); 00062400 END; 00062500 CLOSE(MASTER,SAVE); 00062600 END; 00062700 GO TO WHICH[RSTT+1]; 00062800 COMMENT """"""""""""" START OF PHASE 1 """"""""""""" 00062900 THIS PHASE ACTUALLY BEGINS WHEN FILE SUMS IS OPENED 00063000 AND WRITTEN ON ; 00063100 RSTART1: RESTART1; 00063200 COMMENT """"""""""""" START OF PHASE 0 """"""""""""" ;00063300 RSTART0: 00063400 CORR; 00063500 CLOSE(MASTER,SAVE); 00063600 CLOSE(SUMS,SAVE); 00063700 COMMENT REMOVE WRITE RING AS A SAFETY PRECAUTION AND READ 00063800 TAPE JUST LOCKED; 00063900 COMMENT 00064000 ********************** INNER BLOCK ***************************** ;00064100 COMMENT """"""""""""" START OF PHASE 2 """"""""""""" ;00064200 RSTART2: 00064300 T~0 ; T1~1; 00064400 FOR CT ~ 1 STEP 1 UNTIL NPART DO 00064500 BEGIN 00064600 LABEL RD,REST,INIT; 00064700 COMMENT SAVE REMOVED HERE BY WHE 1-25-67; 00064800 ARRAY D,D1,D2[PARTIT[CT|2-1]:PARTIT[CT|2],0:NVAR1], 00064900 A[0:6]; 00065000 LLIM ~ PARTIT[CT|2-1]; 00065100 TOP ~ ULIM ~ PARTIT[CT|2] ; 00065200 M1 ~ ULIM; M ~ LLIM; 00065300 FOR I~M STEP 1 UNTIL M1 DO READ(SUMS,NVAR,D[I,*]); 00065400 FOR I~M STEP 1 UNTIL M1 DO READ(SUMS,NVAR,D1[I,*]); 00065500 FOR I~M STEP 1 UNTIL M1 DO READ(SUMS,NVAR,D2[I,*]); 00065600 IF CT=1 THEN GO TO INIT; 00065700 REWIND(SC[T]); COMMENT REW HERE SO THAT FINAL 00065800 TAPE IS NOT RESOUND ; 00065900 M2~0; M3~PARTIT[CT|2-1]-1; 00066000 COMMENT A[0] IS TRUE IF RECORD IS COMPLETE; 00066100 FOR I ~ M2 STEP 1 UNTIL M3 DO 00066200 BEGIN 00066300 RD: READ(SC[T][NO],7,A[*]); 00066400 IF BOOLEAN (A[0]) THEN 00066500 BEGIN 00066600 WRITE(SC[T1],7,A[*]) ; READ(SC[T]); 00066700 GO TO RD ; 00066800 END; 00066900 FOR J ~ M STEP 1 UNTIL M1 DO 00067000 BEGIN 00067100 READ(SC[T],7,A[*]); 00067200 A[4] ~ D[J,I]; A[5] ~ D1[J,I]; A[6]~D2[J,I]; 00067300 A[0] ~ 1; 00067400 WRITE(SC[T1],7,A[*]); 00067500 END; 00067600 REST: FOR J ~ TOP +1 STEP 1 UNTIL NVAR1 DO 00067700 BEGIN 00067800 READ(SC[T],7,A[*]); 00067900 WRITE(SC[T1],7,A[*]); 00068000 END; 00068100 END; 00068200 COMMENT FORM COMBINATIONS FROM TAPE SUMS; 00068300 INIT: FOR I ~ M STEP 1 UNTIL M1 DO 00068400 BEGIN 00068500 FOR J ~ I+1 STEP 1 UNTIL M1 DO 00068600 BEGIN 00068700 A[0]~1; A[1]~D [I,J];A[2]~D1[I,J]; A[3]~D2[I,J]; 00068800 A[4]~D[J,I]; A[5]~ D1[J,I]; A[6]~D2[J,I]; 00068900 WRITE (SC[T1],7,A[*]); 00069000 END; 00069100 A[4]~A[5]~A[6]~A[0]~ 0; 00069200 FOR J ~ ULIM+1 STEP 1 UNTIL NVAR1 DO 00069300 BEGIN 00069400 A[1]~D[I,J]; A[2]~D1[I,J]; A[3]~D2[I,J]; 00069500 WRITE(SC[T1],7,A[*]); 00069600 END; 00069700 END; 00069800 REWIND(SC[T]); 00069900 DOUBLE(T,T1,~,T1,T); 00070000 END; 00070100 COMMENT END OF INNER BLOCK; 00070200 COMMENT FINAL TAPE IS SC[T]; 00070300 COMMENT WRITE DIAG ELEMENTS ON BACK END OF SC[T] TAPE ; 00070400 FOR I ~ 0 STEP 1 UNTIL NVAR1 DO 00070500 WRITE(SC[T],7,DIAGN[I,*]); 00070600 CLOSE(SC[T],SAVE); 00070700 CLOSE(SUMS,SAVE); 00070800 COMMENT REMOVE WRITE RING AS A SAFETY PRECAUTION AND READ 00070900 TAPE JUST LOCKED; 00071000 CLOSE(SC[T1],RELEASE); 00071100 IF PRINTORNOT!1 THEN GO TO RSTART4; 00071200 COMMENT """"""""""""" START OF PHASE 3 """"""""""""" ;00071300 RSTART3: 00071400 COMMENT DETERMINE WHICH TAPE WAS FINAL OUTPUT TAPE AND PRINT 00071500 IT - THIS IS REDUNDANT BUT IS NEEDED IN CASE OF A 00071600 RESTART FOR PHASE 3 OR 4 ; 00071700 IF BOOLEAN(NPART) THEN T~1 ELSE T~0; 00071800 WRITE(LINE[PAGE]); 00071900 DATELINE("MISDAT"); 00072000 WRITE(LINE,HED); TOP~ 0; 00072100 FOR M ~ 1 STEP 1 UNTIL NVAR1 DO 00072200 BEGIN 00072300 FOR M1~ M+1 STEP 1 UNTIL NVAR DO 00072400 BEGIN 00072500 READ(SC[T],7,A1[*]); 00072600 WRITE(LINE,FM,M,M1,A1[6],A1[4],A1[1],A1[2],A1[3], 00072700 A1[5]); 00072800 TOP ~ TOP+1; IF TOP>46 THEN 00072900 BEGIN 00073000 TOP~0; WRITE(LINE[PAGE]); 00073100 DATELINE("MISDAT"); 00073200 WRITE(LINE,HED); 00073300 END; 00073400 END; 00073500 WRITE(LINE); TOP ~ TOP+1; 00073600 IF TOP>46 THEN BEGIN TOP~0; WRITE(LINE[PAGE]); %VR 1/69 00073610 WRITE(LINE,HED); END; %VR 1/69 00073620 END; 00073700 TOP ~ TOP+2; 00073800 IF TOP>46 THEN BEGIN TOP~0; WRITE(LINE[PAGE]); %VR 1/69 00073810 WRITE(LINE,HED); END; %VR 1/69 00073820 WRITE(LINE[DBL]); COMMENT GET DIAG ELEMENTS; 00073900 FOR M~1 STEP 1 UNTIL NVAR DO 00074000 BEGIN 00074100 READ(SC[T],7,A1[*]); 00074200 WRITE(LINE,FM,M,M ,A1[6],A1[4],A1[1],A1[2],A1[3], 00074300 A1[5]); 00074400 TOP~TOP+1; IF TOP > 46 THEN 00074500 BEGIN 00074600 TOP ~ 0; WRITE(LINE[PAGE]); 00074700 DATELINE("MISDAT"); 00074800 WRITE(LINE,HED); 00074900 END; 00075000 END; 00075100 REWIND(SC[T]); 00075200 COMMENT SUM Y, SUM Y SQ, SUM XY, ETC JUST PRINTED, REWIND 00075300 TPAE AND READ,COMPUTE, AND PRINT MEAN, STANDARD 00075400 DEVIATION, ETC. ; 00075500 COMMENT """"""""""""" START OF PHASE 4 """"""""""""" ;00075600 RSTART4: 00075700 COMMENT DETERMINE WHICH TAPE WAS FINAL OUTPUT TAPE AND PRINT 00075800 IT - THIS IS REDUNDANT BUT IS NEEDED IN CASE OF A 00075900 RESTART FOR PHASE 3 OR 4 ; 00076000 IF BOOLEAN(NPART) THEN T~1 ELSE T~0; 00076100 BEGIN 00076200 COMMENT R M WATTERS, SUBPROGRAM TO COMPUTE AND PRINT THE 00076300 MEAN OF X ANY Y, STANDARD DEVIATION OF X AND Y, AND 00076400 THE COEFFICIENT OF CORRELATION; 00076500 FORMAT OUT FMT1 (X2,"IDENT",X8,"CORR",X9,"N",X11,"MEAN (X)", 00076600 X12,"MEAN (Y)",X11,"SIGMA (X)",X11, 00076700 "SIGMA (Y)"//); 00076800 FORMAT OUT FMT2 (I4,X1 ,I4,X4,F7.4,X6,I4,X7,F13.4,X7,F13.4, 00076900 X7,F13.4,X7,F13.4 ); 00077000 INTEGER I,J,N,PAGENO,LINENO; 00077100 REAL ARRAY CM[0:NVAR]; 00077200 REAL XT,T1,T2; 00077300 REAL DUMMY,SUMY,SUMYSQD,SUMXY,SUMXSQD,SUMX, 00077400 CORR,MEANX,MEANY,SIGMAX,SIGMAY; 00077500 LIST LST1 (DUMMY,SUMY,SUMYSQD,SUMXY,SUMXSQD,N,SUMX), 00077600 LST2 (I,J,CORR,N,MEANX,MEANY,SIGMAX,SIGMAY); 00077700 LABEL EOF; 00077800 PROCEDURE SOLVER; 00077900 BEGIN 00078000 LABEL L; 00078100 IF N = 0 THEN 00078200 BEGIN 00078300 MEANX~MEANY~SIGMAX~SIGMAY~CORR~0; GO TO L; 00078400 END; 00078500 MEANY ~ SUMY / N; MEANX ~ SUMX / N; 00078600 SIGMAX ~ SQRT ((SUMXSQD / N) - (MEANX * 2)); 00078700 SIGMAY ~ SQRT ((SUMYSQD / N) - (MEANY * 2)); 00078800 XT~SUMXY-(SUMX | SUMY)/N; 00078900 T1~SUMXSQD - (SUMX*2)/N; 00079000 T2~SUMYSQD-(SUMY*2)/N; 00079100 IF T1=0 OR T2=0 THEN CORR~0 ELSE 00079200 CORR~XT/(SQRT(T1) | SQRT(T2)); 00079300 L: 00079400 END OF PROCEDURE SOLVER; 00079500 PROCEDURE NEWPAGE; 00079600 BEGIN 00079700 WRITE (LINE[PAGE]); 00079800 DATELINE("MISDAT"); 00079900 LINENO ~ 0; 00080000 WRITE (LINE,FMT1); 00080100 END OF PROCEDURE NEWPAGE; 00080200 PROCEDURE PROCESSOR; 00080300 BEGIN 00080400 READ (SC[T],*,LST1)[EOF]; 00080500 SOLVER; 00080600 WRITE (LINE,FMT2,LST2); 00080700 LINENO ~ LINENO + 1; 00080800 IF LINENO } 47 THEN NEWPAGE; 00080900 END OF PROCEDURE PROCESSOR; 00081000 COMMENT *****START OF PROGRAM*****; 00081100 NEWPAGE; 00081200 IF CORROUT THEN 00081300 BEGIN 00081400 FOR I~1 STEP 1 UNTIL NVAR1 DO 00081500 BEGIN 00081600 WRITE(LINE); 00081700 LINENO~LINENO+1; 00081800 IF LINENO}47 THEN NEWPAGE; %VR 1/69 00081810 CM[I]~1.0; 00081900 FOR J~I+1 STEP 1 UNTIL NVAR DO 00082000 BEGIN 00082100 PROCESSOR; 00082200 CM[J]~CORR 00082300 END; 00082400 WRITE(TEM ,*, FOR J~1 STEP 1 UNTIL NVAR DO CM[J]); 00082500 END OF ILOOP FOR CORROUT 00082600 END 00082700 ELSE 00082800 FOR I ~ 1 STEP 1 UNTIL NVAR1 DO 00082900 BEGIN 00083000 WRITE (LINE); 00083100 LINENO ~ LINENO + 1; 00083200 IF LINENO}47 THEN NEWPAGE; 00083300 FOR J ~ I + 1 STEP 1 UNTIL NVAR DO 00083400 PROCESSOR; 00083500 END OF ILOOP; 00083600 REWIND(TEM ); 00083700 COMMENT START OF IDENTITY MATRIX; 00083800 WRITE(LINE[DBL]); LINENO~LINENO+2; 00083900 FOR I ~ 1 STEP 1 UNTIL NVAR DO 00084000 BEGIN 00084100 J ~ I; PROCESSOR; 00084200 END OF ILOOP; 00084300 EOF: END OF BLOCK WATTERS; 00084400 END NESTED BLOCK NUMBER 1; 00084500 IF NOT CORROUT THEN GO TO STP ; 00084600 COMMENT ******** NEW BLOCK TO WRITE FULL CORR MATRIX ON TAPE; 00084700 BEGIN 00084800 REAL ARRAY CMT[0:NVAR,0:NVAR]; 00084900 FORMAT FCORMAT(100O) ; 00085000 FILE CORMAT 2(2, 100,SAVE 10); 00085100 FOR I~1 STEP 1 UNTIL NVAR1 DO 00085200 BEGIN 00085300 READ(TEM ,*, FOR J~1 STEP 1 UNTIL NVAR DO CMT[I,J]); 00085400 END; 00085500 CLOSE(TEM ,RELEASE); 00085600 FOR I~1 STEP 1 UNTIL NVAR1 DO 00085700 FOR J~I+1 STEP 1 UNTIL NVAR DO 00085800 CMT[J,I]~CMT[I,J]; 00085900 CMT[NVAR,NVAR]~1.0; 00086000 WRITE(CORMAT,FCORMAT,NVAR) ; 00086100 FOR I~1 STEP 1 UNTIL NVAR DO 00086200 WRITE(CORMAT,FCORMAT,FOR J~1 STEP 1 UNTIL NVAR DO 00086300 CMT[I,J]); 00086400 END; 00086500 STP: 00086600 DATELINE(0); 00086700 END; 00086800 END; 00086900 FINIS: END OF PROGRAM. 00087000 LAST CARD ON CRDIMG TAPE 99999999