mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-03-02 17:44:40 +00:00
2c72f7fd1d
1. Commit library tape images, directories, and extracted text files. 2. Commit additional utilities under Unisys-Emode-Tools.
1036 lines
82 KiB
Plaintext
1036 lines
82 KiB
Plaintext
BEGIN 00000000
|
|
COMMENT MAXPLAN/STATMAN; 00000100
|
|
FILE IN CARD 0(2,10); FILE OUT LINE 4(2,15); 00000200
|
|
FILE OUT PUNCH 0(2,10); 00000300
|
|
BOOLEAN ARRAY SENSL[0:4]; 00000400
|
|
REAL XPR; 00000500
|
|
INTEGER QQ; 00000600
|
|
LABEL FINIS; 00000700
|
|
PROCEDURE ERROR(N); VALUE N; INTEGER N; BEGIN 00000800
|
|
FORMAT F(///////"STOP / PAUSE NO. ", I5); 00000900
|
|
WRITE (LINE, F, N); GO TO FINIS END; 00001000
|
|
REAL PROCEDURE INT(ARG1); VALUE ARG1; REAL ARG1; 00001100
|
|
BEGIN INT~(SIGN(ARG1)|ENTIER(ABS(ARG1))) END; 00001200
|
|
REAL PROCEDURE MAX(ARG1,ARG2); VALUE ARG1,ARG2; REAL ARG1,ARG2; 00001300
|
|
BEGIN MAX~(IF ARG1}ARG2 THEN ARG1 ELSE ARG2) END; 00001400
|
|
REAL PROCEDURE MIN(ARG1,ARG2); VALUE ARG1,ARG2; REAL ARG1,ARG2; 00001500
|
|
BEGIN MIN~(IF ARG1{ARG2 THEN ARG1 ELSE ARG2) END; 00001600
|
|
DEFINE TAPE5=PUNCH#, TAPE7=CARD#,SINQ=SIN#,SQRTQ=SQRT#, 00001700
|
|
COSQ=COS#,ATANQ=ARCTAN#; 00001800
|
|
ARRAY KOUNTQ,LKOUNTQ,NHYPQ,KTOTALQ,ISTABQ,CLONGQ,TCOSQ,TEMQ, 00001900
|
|
SHIFTQ,EXANGQ[0:30],LHYQ[0:400],IPROGQ[0:60],ITPQ[0:9], 00002000
|
|
IPARQ[0:23],VZEROQ[0:30,0:400],COSNQ,CLAMQ[0:30,0:30], 00002100
|
|
FMTQ[0:98],ROWQ[0:150],TITLEQ[0:12]; 00002200
|
|
REAL TOPQ,TIMEQ,TCCQ,TCQ,ANGQ,AHYPPCQ,PC1Q,PC2Q,PC3Q,TTOTALQ, 00002300
|
|
TPLOTQ,UPQ; 00002400
|
|
INTEGER NVARQ,NFACQ, KSWTQ,KHWTQ,KOUNT2Q,K,IMPQ,LASTQ, 00002500
|
|
LEGALQ,L,KRAPQ,MULTQ,KNQ,IMPSQ; 00002600
|
|
DEFINE IPLOTQ=IPARQ[8]#,KANGQ=IPARQ[9]#,KSTARTQ=IPARQ[10]#, 00002700
|
|
NCYCLEQ=IPARQ[11]#,KCYCLEQ=IPARQ[12]#,TOTIMQ=IPARQ[13]#, 00002800
|
|
WIDQ=IPARQ[14]#,SIGQ=IPARQ[15]#,XCLHCQ=IPARQ[16]#, 00002900
|
|
NCLCYQ=IPARQ[17]#,NCLSPQ=IPARQ[18]#,NCLHOQ=IPARQ[19]#, 00003000
|
|
ANFMINQ=IPARQ[20]#,ANGMINQ=IPARQ[21]#,CMAXQ=IPARQ[22]#, 00003100
|
|
NSHQ=IPARQ[23]#; 00003200
|
|
PROCEDURE TIMINQ(A); %******************************* 00003300
|
|
REAL A; 00003400
|
|
A~TIME(1); 00003500
|
|
PROCEDURE TIMOUTQ(A); %******************************* 00003600
|
|
REAL A; 00003700
|
|
A~(TIME(1)-A) DIV 60; 00003800
|
|
FILE IN FACMAT 2(2,100), ROTMAT 2(2,100), CORMAT 2(2,100); 00003900
|
|
FORMAT OKTL(100O); 00004000
|
|
SWITCH FILE SW~LINE,CARD,LINE,LINE,LINE,CORMAT,FACMAT,ROTMAT; 00004100
|
|
COMMENT ************************** PLOT ****************; 00004200
|
|
PROCEDURE PLOTQ; 00004300
|
|
BEGIN 00004400
|
|
OWN INTEGER I; 00004500
|
|
LABEL DUMMY; 00004600
|
|
I ~ 0; 00004700
|
|
GO TO DUMMY; 00004800
|
|
DUMMY: 00004900
|
|
END; 00005000
|
|
00005100
|
|
COMMENT ************************** EXTRA ****************; 00005200
|
|
PROCEDURE EXTRAQ; 00005300
|
|
BEGIN 00005400
|
|
OWN REAL X; 00005500
|
|
LABEL DUMMY; 00005600
|
|
COMMENT 00005700
|
|
THIS IS A DUMMY SUBROUTINE (SEE MAIN PROGRAM); 00005800
|
|
X ~ 0; 00005900
|
|
GO TO DUMMY; 00006000
|
|
DUMMY: 00006100
|
|
END; 00006200
|
|
00006300
|
|
COMMENT ************************** DUMMY ****************; 00006400
|
|
PROCEDURE DUMMYQ; 00006500
|
|
BEGIN 00006600
|
|
OWN REAL X; 00006700
|
|
LABEL DUMMY; 00006800
|
|
COMMENT 00006900
|
|
THIS IS A DUMMY SUBROUTINE (SEE MAIN PROGRAM); 00007000
|
|
X ~ 0; 00007100
|
|
GO TO DUMMY; 00007200
|
|
DUMMY: 00007300
|
|
END; 00007400
|
|
00007500
|
|
COMMENT ************************** HYPPC ****************; 00007600
|
|
PROCEDURE HYPPCQ; 00007700
|
|
BEGIN 00007800
|
|
OWN INTEGER JBQ,JAQ,JCQ; 00007900
|
|
OWN REAL V; 00008000
|
|
LABEL DUMMY,L6003; 00008100
|
|
COMMENT 00008200
|
|
THIS SUBROUTINE CALCULATES THE HYPERPLANE COUNT FOR EACH FACTOR 00008300
|
|
AND ALSO THE COUNT AND PERCENT VALUE OF POINTS FOR THE TOTAL 00008400
|
|
CALCULATE HYPERPLANE COUNT; 00008500
|
|
KOUNT2Q ~ 0; 00008600
|
|
FOR JBQ ~ 1, JBQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00008700
|
|
NHYPQ[JBQ] ~ 0; 00008800
|
|
FOR JAQ ~ 1, JAQ+1 STEP 1 UNTIL NVARQ DO BEGIN 00008900
|
|
V ~ 0; 00009000
|
|
FOR JCQ ~ 1, JCQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00009100
|
|
V ~ V+VZEROQ[JCQ,JAQ]|CLAMQ[JBQ,JCQ] END; 00009200
|
|
IF ABS(V)>WIDQ THEN GO TO L6003; 00009300
|
|
KOUNT2Q ~ KOUNT2Q+1; 00009400
|
|
NHYPQ[JBQ] ~ NHYPQ[JBQ]+1; 00009500
|
|
L6003: END; 00009600
|
|
END; 00009700
|
|
AHYPPCQ ~ (KOUNT2Q)|100/(NFACQ|NVARQ); 00009800
|
|
GO TO DUMMY; 00009900
|
|
DUMMY: 00010000
|
|
END; 00010100
|
|
00010200
|
|
COMMENT ************************** WEIGHT ****************; 00010300
|
|
PROCEDURE WEIGHTQ; 00010400
|
|
BEGIN 00010500
|
|
OWN INTEGER INDEXQ,ISQ,JSQ; 00010600
|
|
OWN REAL V; 00010700
|
|
LABEL DUMMY,L4,L5; 00010800
|
|
COMMENT 00010900
|
|
THIS IS THE SUBROUTINE THAT WEIGHTS THE POINTS WHEN FACTOR K 00011000
|
|
IS BEING SHIFTED ON FACTOR L; 00011100
|
|
INDEXQ ~ KSWTQ+1; 00011200
|
|
FOR ISQ ~ 1, ISQ+1 STEP 1 UNTIL NVARQ DO BEGIN 00011300
|
|
LHYQ[ISQ] ~ 0; 00011400
|
|
V ~ 0; 00011500
|
|
FOR JSQ ~ 1, JSQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00011600
|
|
V ~ V+VZEROQ[JSQ,ISQ]|CLAMQ[L,JSQ] END; 00011700
|
|
IF ABS(V)<WIDQ THEN GO TO L5; 00011800
|
|
IF KSWTQ>0 THEN GO TO L4; 00011900
|
|
LHYQ[ISQ] ~ 1; 00012000
|
|
GO TO L5; 00012100
|
|
L4: LHYQ[ISQ] ~ INT((5|ABS(V))*INDEXQ); 00012200
|
|
L5: END; 00012300
|
|
GO TO DUMMY; 00012400
|
|
DUMMY: 00012500
|
|
END; 00012600
|
|
00012700
|
|
COMMENT ************************** MXHEAD ****************; 00012800
|
|
PROCEDURE MXHEADQ; 00012900
|
|
BEGIN 00013000
|
|
INTEGER DX1; 00013100
|
|
INTEGER INDEX1; 00013200
|
|
FORMAT FL100(///" MAXPLANE OF 1 DECEMBER 1965 "), 00013300
|
|
FL102(//" PARAMETERS ARE"/X7," (1)",R9.3,X7," (2)",I5,X11, 00013400
|
|
" (3)",I5,X11," (4)",I5,X11," (5)",I5/X7," (6)",I5,X11, 00013500
|
|
" (7)",I5,X11," (8)",I5,X11," (9)",I5,X11,"(10)",I5/X7, 00013600
|
|
"(11)",I5,X11,"(12)",I5,X11,"(13)",R9.3,X7,"(14)",R9.3,X7, 00013700
|
|
"(15)",R9.3/X7,"(16)",I5,X11,"(17)",R9.3,X7,"(18)",I5,X11, 00013800
|
|
"(19)",I5,X11,"(20)",R9.3/X7,"(21)",R9.3,X7,"(22)",R9.3,X7, 00013900
|
|
"(23)",I5,X11,"(24)",I5,X11,"(25)",R9.3/X7,"(26)",I5,X11, 00014000
|
|
"(27)",I5/), 00014100
|
|
FL103(" "////X39,"I L L I N O I S M A X P L A N E"//X24, 00014200
|
|
12A6//X41,"ROTATION TO SIMPLE STRUCTURE"/X41,"WITH",I4, 00014300
|
|
" VARIABLES",I5," FACTORS"/X41,"HYPERPLANE WIDTH TAKEN AS", 00014400
|
|
R6.3///), 00014500
|
|
FL101(X16,"SHIFTED ON",X9,"HYPERPLANE COUNT",X5,"HYPERPLANE"/ 00014600
|
|
X5,"FACTOR FACTOR ANGLE THIS FACTOR ALL FACTORS ", 00014700
|
|
"PER CENT"); 00014800
|
|
LIST LIST1(TOTIMQ,FOR DX1 ~ 2 STEP 1 UNTIL 12 DO IPARQ[DX1],WIDQ,SIGQ, 00014900
|
|
ANFMINQ,NCLCYQ,XCLHCQ,NCLSPQ,NCLHOQ,UPQ,PC1Q,PC2Q,KHWTQ,KSWTQ, 00015000
|
|
TTOTALQ,KRAPQ,MULTQ), 00015100
|
|
LIST2(FOR INDEX1 ~ 1 STEP 1 UNTIL 12 DO TITLEQ[INDEX1],NVARQ, 00015200
|
|
NFACQ,WIDQ); 00015300
|
|
LABEL DUMMY; 00015400
|
|
COMMENT 00015500
|
|
THIS SUBROUTINE LISTS THE PARAMETERS AND PRINTS THE HEADING; 00015600
|
|
WRITE(LINE,FL100); 00015700
|
|
WRITE(LINE,FL102,LIST1); 00015800
|
|
WRITE(LINE,FL103,LIST2); 00015900
|
|
WRITE(LINE,FL101); 00016000
|
|
GO TO DUMMY; 00016100
|
|
DUMMY: 00016200
|
|
END; 00016300
|
|
00016400
|
|
COMMENT ************************** TIMOK ****************; 00016500
|
|
PROCEDURE TIMOKQ(L); 00016600
|
|
INTEGER L; 00016700
|
|
BEGIN 00016800
|
|
OWN REAL T,Y; 00016900
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00017000
|
|
TIMOUT, TIME; 00017100
|
|
LABEL DUMMY,L1,L2; 00017200
|
|
COMMENT 00017300
|
|
THIS SUBROUTINE CALCULATES IF THERE IS ENOUGH TIME FOR ONE 00017400
|
|
MORE CYCLE AND BASIC OUTPUT. TIME IS NOT ALLOWED FOR PLOTTING.; 00017500
|
|
TIMOUTQ(TCQ); 00017600
|
|
TOPQ ~ MAX(TOPQ,TCQ); 00017700
|
|
T ~ TIMEQ; 00017800
|
|
TIMOUTQ(T); 00017900
|
|
Y ~ (NVARQ); 00018000
|
|
IF TOTIMQ-T-TOPQ>.25|Y THEN GO TO L2 ELSE GO TO L1; 00018100
|
|
COMMENT 00018200
|
|
THERE IS SUFFICIENT TIME; 00018300
|
|
L1: L ~ 1; 00018400
|
|
GO TO DUMMY; 00018500
|
|
COMMENT 00018600
|
|
THERE IS NOT SUFFICIENT TIME; 00018700
|
|
L2: L ~ -1; 00018800
|
|
GO TO DUMMY; 00018900
|
|
DUMMY: 00019000
|
|
END; 00019100
|
|
00019200
|
|
COMMENT ************************** MXEND ****************; 00019300
|
|
PROCEDURE MXENDQ; 00019400
|
|
BEGIN 00019500
|
|
OWN REAL TTOTMQ,TTOTSQ; 00019600
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00019700
|
|
TIMOUT, TIME; 00019800
|
|
FORMAT FL5080(" ",X2,"NUMBER OF CYCLES =",I5,X10, 00019900
|
|
"TOTAL MAXPLANE TIME =",R4.0,R6.1/), 00020000
|
|
FL5081(/" LAST CYCLE TIME=",R6.1,X10,"GREATEST CYCLE TIME=", 00020100
|
|
R6.1,X10,"TOTAL OUTPUT TIME=",R6.1,X10/ 00020200
|
|
"PLOT SUBROUTINE TIME=",R6.1/" ",X52, 00020300
|
|
"(ABOVE TIMES ARE IN SECONDS)"/" "), 00020400
|
|
FL5003(/" TIMES FOR THIS RUN",X22,"TOTAL TIME =",R4.0,R6.1/ 00020500
|
|
X30,"(ABOVE TIMES IN MINUTES AND SECONDS MM SS.S)"); 00020600
|
|
LIST LIST1(KCYCLEQ,TTOTMQ,TTOTSQ), 00020700
|
|
LIST2(TTOTMQ,TTOTSQ), 00020800
|
|
LIST3(TCQ,TOPQ,TCCQ,TPLOTQ); 00020900
|
|
LABEL DUMMY; 00021000
|
|
COMMENT 00021100
|
|
THIS SUBROUTINE PRINTS SOME STATISTICS GIVING THE NUMBER OF 00021200
|
|
CYCLES AND VARIOUS TIMES; 00021300
|
|
TIMOUTQ(TIMEQ); 00021400
|
|
TTOTMQ ~ TTOTALQ/60; 00021500
|
|
TTOTMQ ~ INT(TTOTMQ); 00021600
|
|
TTOTSQ ~ TTOTALQ-60|TTOTMQ; 00021700
|
|
WRITE(LINE,FL5080,LIST1); 00021800
|
|
TTOTMQ ~ TIMEQ/60; 00021900
|
|
TTOTMQ ~ INT(TTOTMQ); 00022000
|
|
TTOTSQ ~ TIMEQ-60|TTOTMQ; 00022100
|
|
WRITE(LINE,FL5003,LIST2); 00022200
|
|
TIMOUTQ(TCCQ); 00022300
|
|
WRITE(LINE,FL5081,LIST3); 00022400
|
|
GO TO DUMMY; 00022500
|
|
DUMMY: 00022600
|
|
END; 00022700
|
|
00022800
|
|
COMMENT ************************** MXTEST ****************; 00022900
|
|
PROCEDURE MXTESTQ; 00023000
|
|
BEGIN 00023100
|
|
OWN INTEGER J; 00023200
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00023300
|
|
TIMOK, TIMOUT; 00023400
|
|
FORMAT FL112(X30,"*** DOUBLE SHIFTS STARTED"), 00023500
|
|
FL100(X30,"***MINIMUM ANGLE OF SEPARATION SET AT 30 DEGREES"), 00023600
|
|
FL101(X30, 00023700
|
|
"***POINTS WEIGHTED 1 IN 1/1, 5 IN 2/3, 15 IN 1/3 OF ", 00023800
|
|
"HYPERPLANE WIDTH "), 00023900
|
|
FL102(X30,"***OUTLYING HYPERPLANE POINTS WEIGHTED"), 00024000
|
|
FL103(X30,"***NO IMPROVEMENT IN STRUCTURE"), 00024100
|
|
FL104(X30,"***LESS THAN ",R4.1, 00024200
|
|
" PERCENT IMPROVEMENT IN 3 CYCLES"), 00024300
|
|
FL111(X30,"***SS HAS BEEN REACHED. BEGINNING FINAL SCAN."), 00024400
|
|
FL105(X30,"***2 DEGREE SHIFTS TO BE STARTED"), 00024500
|
|
FL106(X30,"***OUTLYING HYPERPLANE POINTS NOT WEIGHTED"), 00024600
|
|
FL107(//X30,"***MAXIMUM SIMPLE STRUCTURE HAS BEEN REACHED"//), 00024700
|
|
FL108(//X30, 00024800
|
|
"***MAXIMUM SIMPLE STRUCTURE FOR 6 DEGREE SHIFTS HAS ", 00024900
|
|
"BEEN REACHED"//), 00025000
|
|
FL109(//X30, 00025100
|
|
"***INSUFFICIENT TIME FOR NEXT CYCLE - PROGRAM WILL G", 00025200
|
|
"O TO OUTPUT",". THERE WILL BE NO PLOT."//), 00025300
|
|
FL110(X30, 00025400
|
|
"***THE SPECIFIED NUMBER OF CYCLES HAVE BEEN COMPLETE","D"/); 00025500
|
|
LIST LIST1(UPQ); 00025600
|
|
LABEL DUMMY,L1,L2,L3,L4,L5,L7,L9,L10,L11,L12,L13,L14,L15,L16,L17, 00025700
|
|
L80,L18,L182,L20,L21,L22,L23; 00025800
|
|
COMMENT 00025900
|
|
THIS SUBROUTINE TESTS FOR TERMINATING CONDITIONS AT THE END 00026000
|
|
OF EACH CYCLE 00026100
|
|
TEST IF SPECIFIED NUMBER OF CYCLES HAVE BEEN COMPLETED; 00026200
|
|
IF NCYCLEQ=KCYCLEQ THEN GO TO L23 ELSE GO TO L1; 00026300
|
|
COMMENT 00026400
|
|
TEST IF NUMBER OF CYCLES FOR MINIMUM ANGLE CHANGE ATTAINED; 00026500
|
|
L1: IF NCLCYQ=KCYCLEQ THEN GO TO L12 ELSE GO TO L2; 00026600
|
|
COMMENT 00026700
|
|
TEST IF HYPERPLANE 0/0 FOR MINIMUN ANGLE CHANGE ATTAINED; 00026800
|
|
L2: IF XCLHCQ>AHYPPCQ THEN GO TO L3 ELSE GO TO L11; 00026900
|
|
COMMENT 00027000
|
|
TEST IF CYCLE NUMBER FOR HYPERPLANE SPREAD WEIGHTING ATTAINED; 00027100
|
|
L3: IF NCLSPQ=KCYCLEQ THEN GO TO L13 ELSE GO TO L4; 00027200
|
|
COMMENT 00027300
|
|
TEST IF CYCLE NUMBER FOR WEIGHTING HYPERPLANE OUTLYERS ATTAINED; 00027400
|
|
L4: IF NCLHOQ=KCYCLEQ THEN GO TO L14 ELSE GO TO L5; 00027500
|
|
COMMENT 00027600
|
|
TEST FOR ANY IMPROVEMENT; 00027700
|
|
L5: IF IMPQ{0 THEN GO TO L15; 00027800
|
|
PC3Q ~ PC2Q; 00027900
|
|
PC2Q ~ PC1Q; 00028000
|
|
PC1Q ~ AHYPPCQ; 00028100
|
|
COMMENT 00028200
|
|
TEST FOR 3 CYCLE IMPROVEMENT LESS THAN SPECIFIED AMOUNT; 00028300
|
|
IF AHYPPCQ-PC3Q}UPQ THEN GO TO L7 ELSE GO TO L16; 00028400
|
|
COMMENT 00028500
|
|
TEST IF THERE IS SUFFICIENT TIME FOR ANOTHER CYCLE; 00028600
|
|
L7: TIMOKQ(L); 00028700
|
|
IF L}0 THEN GO TO L22; 00028800
|
|
LASTQ ~ 0; 00028900
|
|
L9: GO TO DUMMY; 00029000
|
|
COMMENT 00029100
|
|
SET INDICATOR TO SHOW THAT CYCLING TO BE TERMINATED; 00029200
|
|
L10: LASTQ ~ 1; 00029300
|
|
TIMOUTQ(TCQ); 00029400
|
|
GO TO DUMMY; 00029500
|
|
L11: NCLSPQ ~ KCYCLEQ; 00029600
|
|
NCLCYQ ~ KCYCLEQ; 00029700
|
|
MULTQ ~ 1; 00029800
|
|
WRITE(LINE,FL112); 00029900
|
|
L12: XCLHCQ ~ 200; 00030000
|
|
CMAXQ ~ 0.86603; 00030100
|
|
ANGMINQ ~ 0.5235988; 00030200
|
|
ANFMINQ ~ 30; 00030300
|
|
NSHQ ~ 20; 00030400
|
|
WRITE(LINE,FL100); 00030500
|
|
GO TO L3; 00030600
|
|
L13: KHWTQ ~ KHWTQ+1; 00030700
|
|
IF KHWTQ<1 THEN GO TO L4; 00030800
|
|
WRITE(LINE,FL101); 00030900
|
|
GO TO L4; 00031000
|
|
L14: IF KSWTQ<0 THEN GO TO L5; 00031100
|
|
WRITE(LINE,FL102); 00031200
|
|
KSWTQ ~ MAX(LEGALQ,1); 00031300
|
|
GO TO L5; 00031400
|
|
L15: WRITE(LINE,FL103); 00031500
|
|
GO TO L17; 00031600
|
|
L16: WRITE(LINE,FL104,LIST1); 00031700
|
|
COMMENT 00031800
|
|
TERMINATE IF 2 DEGREE SHIFTS WERE BEING DONE, OTHERWISE TEST IF 00031900
|
|
THEY ARE REQUIRED AND ADJUST PARAMETERS ACCORDINGLY; 00032000
|
|
L17: IF KANGQ}2 THEN GO TO L80; 00032100
|
|
IF KHWTQ{0 THEN GO TO L18; 00032200
|
|
L80: IF KRAPQ!0 THEN GO TO L20; 00032300
|
|
WRITE(LINE,FL111); 00032400
|
|
KANGQ ~ 1; 00032500
|
|
MULTQ ~ 0; 00032600
|
|
KHWTQ ~ 0; 00032700
|
|
NSHQ ~ 20; 00032800
|
|
KRAPQ ~ 1; 00032900
|
|
ANFMINQ ~ 60; 00033000
|
|
XCLHCQ ~ 50; 00033100
|
|
NCLCYQ ~ 4; 00033200
|
|
ANGMINQ ~ 1.047198; 00033300
|
|
ANGQ ~ .1047198; 00033400
|
|
KSWTQ ~ 0; 00033500
|
|
FOR J ~ 1, J+1 STEP 1 UNTIL NFACQ DO BEGIN 00033600
|
|
ISTABQ[J] ~ 0 END; 00033700
|
|
GO TO L7; 00033800
|
|
L18: IF KANGQ>0 THEN GO TO L21; 00033900
|
|
IF NCLSPQ>KCYCLEQ THEN GO TO L182; 00034000
|
|
WRITE(LINE,FL105); 00034100
|
|
CMAXQ ~ .86603; 00034200
|
|
KANGQ ~ 2; 00034300
|
|
ANGMINQ ~ .5235988; 00034400
|
|
ANFMINQ ~ 30; 00034500
|
|
NSHQ ~ 5; 00034600
|
|
KSWTQ ~ -5; 00034700
|
|
NCLHOQ ~ KCYCLEQ; 00034800
|
|
PC1Q ~ 0; 00034900
|
|
PC2Q ~ 0; 00035000
|
|
WRITE(LINE,FL106); 00035100
|
|
WRITE(LINE,FL100); 00035200
|
|
GO TO L7; 00035300
|
|
L182: KHWTQ ~ KHWTQ+1; 00035400
|
|
NCLSPQ ~ KCYCLEQ; 00035500
|
|
IF KHWTQ<1 THEN GO TO L7; 00035600
|
|
WRITE(LINE,FL101); 00035700
|
|
PC2Q ~ 0; 00035800
|
|
PC3Q ~ 0; 00035900
|
|
GO TO L7; 00036000
|
|
L20: WRITE(LINE,FL107); 00036100
|
|
GO TO L10; 00036200
|
|
L21: WRITE(LINE,FL108); 00036300
|
|
GO TO L10; 00036400
|
|
L22: WRITE(LINE,FL109); 00036500
|
|
TPLOTQ ~ 1; 00036600
|
|
LASTQ ~ 1; 00036700
|
|
GO TO DUMMY; 00036800
|
|
L23: WRITE(LINE,FL110); 00036900
|
|
GO TO L10; 00037000
|
|
DUMMY: 00037100
|
|
END; 00037200
|
|
00037300
|
|
COMMENT ************************** MXROTN ****************; 00037400
|
|
PROCEDURE MXROTNQ; 00037500
|
|
BEGIN 00037600
|
|
OWN INTEGER NPOSQ,KPREVQ,KTOTQ,M,MAQ,ITOTQ,MEQ,MFQ,KJQ,K0Q,KLQ,MBQ; 00037700
|
|
OWN REAL W3Q,W23Q,B,XNPOSQ,CORRMQ,TRYQ,EXQ,SHIFTLQ,SUMSQQ,V; 00037800
|
|
COMMENT THE FOLLOWING FUNCTIONS ARE REQUIRED: 00037900
|
|
ATAN, SQRT, SIN; 00038000
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00038100
|
|
WEIGHT; 00038200
|
|
BEGIN 00038300
|
|
LABEL DUMMY,L32,L33,L34,L4102,L5014,L5073,L400,L401,L42,L5022,L43, 00038400
|
|
L44,L45,L5075,L201,L540,L541,L542,L551,L553,L555,L320,L556, 00038500
|
|
L321,L544,L68,L203; 00038600
|
|
COMMENT 00038700
|
|
IN THIS SUBROUTINE FACTOR K IS ROTATED AGAINST FACTOR L. ALL 00038800
|
|
SHIFT POSITIONS THAT DO NOT VIOLATE THE ANGLE RESTRICTION ARE 00038900
|
|
TRIED AND IF ANY OF THESE IS BETTER THAN THE ORIGINAL POSITION 00039000
|
|
THE FACTOR IS SHIFTED TO THE BEST OF THESE.; 00039100
|
|
IMPSQ ~ 0; 00039200
|
|
W3Q ~ WIDQ/3; 00039300
|
|
W23Q ~ 2|W3Q; 00039400
|
|
COMMENT 00039500
|
|
CALCULATE ANGLES BETWEEN FACTORS; 00039600
|
|
FOR L ~ 1, L+1 STEP 1 UNTIL NFACQ DO BEGIN 00039700
|
|
IF L!K THEN GO TO L32; 00039800
|
|
EXANGQ[L] ~ 0; 00039900
|
|
GO TO L34; 00040000
|
|
L32: IF ABS(COSNQ[L,K])<.0349 THEN GO TO L33; 00040100
|
|
EXANGQ[L] ~ ATANQ((SQRTQ(1-COSNQ[L,K]*2))/COSNQ[ 00040200
|
|
L,K]); 00040300
|
|
IF EXANGQ[L]>0 THEN GO TO L34; 00040400
|
|
EXANGQ[L] ~ EXANGQ[L]+3.14159; 00040500
|
|
GO TO L34; 00040600
|
|
L33: EXANGQ[L] ~ 1.57079; 00040700
|
|
L34: LKOUNTQ[L] ~ 0 END; 00040800
|
|
COMMENT 00040900
|
|
CYCLE THAT PAIRS FACTOR WITH EACH OTHER FACTOR STARTS; 00041000
|
|
FOR L ~ 1, L+1 STEP 1 UNTIL NFACQ DO BEGIN 00041100
|
|
SHIFTQ[L] ~ 0; 00041200
|
|
COMMENT 00041300
|
|
DO NOT TRY AND SHIFT FACTOR ON ITSELF; 00041400
|
|
IF L=K THEN GO TO L201; 00041500
|
|
WEIGHTQ; 00041600
|
|
COMMENT 00041700
|
|
CALCULATE SHIFT POSITIONS; 00041800
|
|
B ~ EXANGQ[L]-ANGMINQ; 00041900
|
|
XNPOSQ ~ B/ANGQ; 00042000
|
|
NPOSQ ~ INT(XNPOSQ); 00042100
|
|
IF XNPOSQ}0 THEN GO TO L4102; 00042200
|
|
NPOSQ ~ NPOSQ-1; 00042300
|
|
L4102: IF KANGQ<2 THEN GO TO L5014; 00042400
|
|
NPOSQ ~ 2; 00042500
|
|
L5014: KPREVQ ~ 0; 00042600
|
|
KTOTQ ~ 0; 00042700
|
|
COMMENT 00042800
|
|
START OF CYCLE THAT TRIES EACH SHIFT POSITION; 00042900
|
|
FOR M ~ 1, M+1 STEP 1 UNTIL NSHQ DO BEGIN 00043000
|
|
CORRMQ ~ M-NSHQ+NPOSQ; 00043100
|
|
TRYQ ~ CORRMQ|ANGQ; 00043200
|
|
EXQ ~ EXANGQ[L]; 00043300
|
|
IF TRYQ}0 THEN GO TO L5073; 00043400
|
|
EXQ ~ 3.14159-EXQ; 00043500
|
|
L5073: SHIFTLQ ~ SINQ(TRYQ)/SINQ(EXQ-ABS(TRYQ)); 00043600
|
|
COMMENT 00043700
|
|
CALCULATE LAMBDA VECTOR FOR PROPOSED SHIFT; 00043800
|
|
SUMSQQ ~ 0; 00043900
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00044000
|
|
CLONGQ[MAQ] ~ CLAMQ[K,MAQ]+CLAMQ[L,MAQ]|SHIFTLQ; 00044100
|
|
SUMSQQ ~ SUMSQQ+CLONGQ[MAQ]*2 END; 00044200
|
|
SUMSQQ ~ 1/SQRTQ(SUMSQQ); 00044300
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00044400
|
|
CLONGQ[MAQ] ~ CLONGQ[MAQ]|SUMSQQ END; 00044500
|
|
COMMENT 00044600
|
|
COUNT (WEIGHTED) SUM OF HYPERPLANE VARIABLES; 00044700
|
|
ITOTQ ~ 0; 00044800
|
|
FOR MEQ ~ 1, MEQ+1 STEP 1 UNTIL NVARQ DO BEGIN 00044900
|
|
COMMENT 00045000
|
|
TO AVOID FACTORS SHARING HYPERPLANES DO NOT COUNT POINTS THAT 00045100
|
|
ARE IN THE HYPERPLANE OF L; 00045200
|
|
IF LHYQ[MEQ]{0 THEN GO TO L42; 00045300
|
|
V ~ 0; 00045400
|
|
FOR MFQ ~ 1, MFQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00045500
|
|
V ~ V+VZEROQ[MFQ,MEQ]|CLONGQ[MFQ] END; 00045600
|
|
V ~ ABS(V); 00045700
|
|
IF V}WIDQ THEN GO TO L42; 00045800
|
|
IF KHWTQ>0 THEN GO TO L401 ELSE GO TO L400; 00045900
|
|
COMMENT 00046000
|
|
DO NOT WEIGHT ACCORDING TO HYPERPLANE SPREAD; 00046100
|
|
L400: ITOTQ ~ ITOTQ+LHYQ[MEQ]; 00046200
|
|
GO TO L42; 00046300
|
|
COMMENT 00046400
|
|
WEIGHT ACCORDING TO HYPERPLANE SPREAD; 00046500
|
|
L401: ITOTQ ~ ITOTQ+LHYQ[MEQ]; 00046600
|
|
COMMENT 00046700
|
|
LHY WILL BE 1 IF THERE IS NO WEIGHTING OF OUTLYERS; 00046800
|
|
IF V}W23Q THEN GO TO L42; 00046900
|
|
ITOTQ ~ ITOTQ+4; 00047000
|
|
IF V}W3Q THEN GO TO L42; 00047100
|
|
ITOTQ ~ ITOTQ+5; 00047200
|
|
L42: END; 00047300
|
|
IF CORRMQ=0 THEN GO TO L5022 ELSE GO TO L43; 00047400
|
|
COMMENT 00047500
|
|
SET COUNT FOR ORIGINAL POSITION; 00047600
|
|
L5022: KPREVQ ~ ITOTQ; 00047700
|
|
L43: KOUNTQ[M] ~ ITOTQ; 00047800
|
|
COMMENT 00047900
|
|
CHOOSE BEST POSITION (IT MAY BE THE ORIGINAL ONE); 00048000
|
|
IF KTOTQ>KOUNTQ[M] THEN GO TO L44; 00048100
|
|
KTOTQ ~ KOUNTQ[M]; 00048200
|
|
KJQ ~ M; 00048300
|
|
L44: END; 00048400
|
|
COMMENT 00048500
|
|
IF NO POSITION BETTER THAN ORIGINAL GO TO NEXT SHIFT PLANE; 00048600
|
|
IF KTOTQ>KPREVQ THEN GO TO L45 ELSE GO TO L201; 00048700
|
|
COMMENT 00048800
|
|
RECORD BEST SHIFT AND HYPERPLANE COUNT; 00048900
|
|
L45: CORRMQ ~ KJQ-NSHQ+NPOSQ; 00049000
|
|
TRYQ ~ CORRMQ|ANGQ; 00049100
|
|
EXQ ~ EXANGQ[L]; 00049200
|
|
EXANGQ[L] ~ TRYQ; 00049300
|
|
IF TRYQ}0 THEN GO TO L5075; 00049400
|
|
EXQ ~ 3.14159-EXQ; 00049500
|
|
L5075: SHIFTQ[L] ~ SINQ(TRYQ)/SINQ(EXQ-ABS(TRYQ)); 00049600
|
|
LKOUNTQ[L] ~ KOUNTQ[KJQ]-KPREVQ; 00049700
|
|
L201: END; 00049800
|
|
COMMENT 00049900
|
|
ALL BEST MOVES ARE NOW IN SHIFT(L); 00050000
|
|
IF KANGQ>0 THEN GO TO L541; 00050100
|
|
L540: KNQ ~ 1; 00050200
|
|
GO TO L542; 00050300
|
|
L541: IF MULTQ{0 THEN GO TO L540; 00050400
|
|
KNQ ~ MAX(KNQ,2); 00050500
|
|
L542: M ~ 0; 00050600
|
|
K0Q ~ 1; 00050700
|
|
FOR KLQ ~ 1, KLQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00050800
|
|
TEMQ[KLQ] ~ 0 END; 00050900
|
|
L551: KTOTQ ~ 0; 00051000
|
|
FOR L ~ 1, L+1 STEP 1 UNTIL NFACQ DO BEGIN 00051100
|
|
IF LKOUNTQ[L]{KTOTQ THEN GO TO L553; 00051200
|
|
KTOTQ ~ LKOUNTQ[L]; 00051300
|
|
KJQ ~ L; 00051400
|
|
M ~ 1; 00051500
|
|
L553: END; 00051600
|
|
IF KTOTQ>0 THEN GO TO L555; 00051700
|
|
IF M>0 THEN GO TO L556 ELSE GO TO L320; 00051800
|
|
L555: TEMQ[KJQ] ~ SHIFTQ[KJQ]; 00051900
|
|
LKOUNTQ[KJQ] ~ -LKOUNTQ[KJQ]; 00052000
|
|
KOUNTQ[K0Q] ~ KJQ; 00052100
|
|
K0Q ~ K0Q+1; 00052200
|
|
IF K0Q>KNQ THEN GO TO L556 ELSE GO TO L551; 00052300
|
|
COMMENT 00052400
|
|
IF NO IMPROVING SHIFTS NOTE THAT THIS FACTOR WAS NOT MOVED; 00052500
|
|
L320: ISTABQ[K] ~ 1; 00052600
|
|
GO TO DUMMY; 00052700
|
|
L556: KOUNTQ[K0Q] ~ 0; 00052800
|
|
L321: TEMQ[K] ~ 1; 00052900
|
|
COMMENT 00053000
|
|
CALCULATE THE NEW LAMBDA VECTOR FOR THIS FACTOR; 00053100
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00053200
|
|
V ~ 0; 00053300
|
|
FOR MBQ ~ 1, MBQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00053400
|
|
V ~ V+CLAMQ[MBQ,MAQ]|TEMQ[MBQ] END; 00053500
|
|
CLONGQ[MAQ] ~ V END; 00053600
|
|
COMMENT 00053700
|
|
NORMALIZE; 00053800
|
|
SUMSQQ ~ 0; 00053900
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00054000
|
|
SUMSQQ ~ SUMSQQ+CLONGQ[MAQ]*2 END; 00054100
|
|
SUMSQQ ~ 1/SQRTQ(SUMSQQ); 00054200
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00054300
|
|
CLONGQ[MAQ] ~ CLONGQ[MAQ]|SUMSQQ END; 00054400
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00054500
|
|
V ~ 0; 00054600
|
|
IF MAQ=K THEN GO TO L68; 00054700
|
|
FOR MBQ ~ 1, MBQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00054800
|
|
V ~ V+CLONGQ[MBQ]|CLAMQ[MAQ,MBQ] END; 00054900
|
|
COMMENT 00055000
|
|
CHECK THAT ALL COSINES ARE WITHIN LEGAL RANGE; 00055100
|
|
IF ABS(V){CMAXQ THEN GO TO L68; 00055200
|
|
IF KNQ>1 THEN GO TO L544; 00055300
|
|
KJQ ~ KOUNTQ[1]; 00055400
|
|
LKOUNTQ[KJQ] ~ 0; 00055500
|
|
GO TO L542; 00055600
|
|
L544: KJQ ~ KOUNTQ[KNQ]; 00055700
|
|
TEMQ[KJQ] ~ 0; 00055800
|
|
LKOUNTQ[KJQ] ~ -LKOUNTQ[KJQ]; 00055900
|
|
KNQ ~ KNQ-1; 00056000
|
|
GO TO L321; 00056100
|
|
L68: TCOSQ[MAQ] ~ V END; 00056200
|
|
COMMENT 00056300
|
|
SET COSINES AND LAMBDA MATRICES FOR NEW POSITION; 00056400
|
|
FOR MAQ ~ 1, MAQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00056500
|
|
COSNQ[K,MAQ] ~ TCOSQ[MAQ]; 00056600
|
|
CLAMQ[K,MAQ] ~ CLONGQ[MAQ]; 00056700
|
|
COSNQ[MAQ,K] ~ TCOSQ[MAQ] END; 00056800
|
|
COMMENT 00056900
|
|
NOTE THERE WAS AN IMPROVEMENT; 00057000
|
|
IMPSQ ~ 1; 00057100
|
|
L203: GO TO DUMMY; 00057200
|
|
DUMMY: 00057300
|
|
END END; 00057400
|
|
00057500
|
|
COMMENT ************************** MXOUT ****************; 00057600
|
|
PROCEDURE MXOUTQ; 00057700
|
|
BEGIN 00057800
|
|
INTEGER DX1; 00057900
|
|
OWN INTEGER J1Q,J2Q,J3Q,I,JAQ,JBQ,JCQ,MAXRQ,J,DX2; 00058000
|
|
DEFINE VECTORQ=LHYQ#; 00058100
|
|
OWN REAL TIQ,X,V; 00058200
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00058300
|
|
TIMIN, TIME, TIMOUT, PWRITE, HYPPC; 00058400
|
|
FORMAT FL3005("DATA (",I5,") IN FORMAT ( 6X,6E12.5 )"), 00058500
|
|
FL3006(2I3,6R12.5), 00058600
|
|
FL3009("END OF DATA"), 00058700
|
|
FL10(R4.0,11I2,S3,2R3.0,S1,R2.0,I2,S1,R4.0,2I2,S1,3R4.0,2I2, 00058800
|
|
R10.2,2I1), 00058900
|
|
FL3004(//X30, 00059000
|
|
"***TRANSFORMATION MATRIX AND NEW PARAMETER CARD HAVE", 00059100
|
|
" BEEN PUNCHED"///), 00059200
|
|
FL3002(" ",X20, 00059300
|
|
"VECTOR COSINES (MAXIMUM COSINE ALLOWED BETWEEN VECT", 00059400
|
|
"ORS IS ",R6.3,")"), 00059500
|
|
FL2002(/" ",20R6.3/(" ",20R6.3)), 00059600
|
|
FL2012(" "//" ",X20,"TRANSFORMATION MATRIX (LAMBDA)"), 00059700
|
|
FL8010(/" PER CENT OF VARIABLES IN",R6.3," HYPERPLANE IS", 00059800
|
|
R5.1/), 00059900
|
|
FL2014(" ",X20,"REFERENCE STRUCTURE V(RS)"//X3,20I6/X6,20I6), 00060000
|
|
FL2003(/" ",I3,X1,20R6.3/(X8,20R6.3)), 00060100
|
|
FL2016(/" ",X3,20I6/(X4,20I6)), 00060200
|
|
FL2015(" ",X20, 00060300
|
|
"REFERENCE VECTOR STRUCTURE V(RS) WITH NON-SALIENT VA", 00060400
|
|
"LUES LESS THAN",R6.3," SUPPRESSED"//X7,30I4), 00060500
|
|
FL2044(I5,X2,S2,30R4.0); 00060600
|
|
LIST LIST1(NFACQ), 00060700
|
|
LIST2(K,J1Q,FOR DX1 ~ J2Q STEP 1 UNTIL J3Q DO CLAMQ[DX1,K]), 00060800
|
|
LIST3(TOTIMQ,FOR DX1 ~ 2 STEP 1 UNTIL 12 DO IPARQ[DX1],WIDQ,SIGQ, 00060900
|
|
ANFMINQ,NCLCYQ,XCLHCQ,NCLSPQ,NCLHOQ,UPQ,PC1Q,PC2Q,KHWTQ,KSWTQ, 00061000
|
|
TTOTALQ,KRAPQ,MULTQ), 00061100
|
|
LIST4(CMAXQ), 00061200
|
|
LIST5(FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO COSNQ[DX1,K]), 00061300
|
|
LIST6(FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO CLAMQ[DX1,K]), 00061400
|
|
LIST7(WIDQ,AHYPPCQ), 00061500
|
|
LIST8(FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO DX1), 00061600
|
|
LIST9(K,FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO VZEROQ[DX1,K]), 00061700
|
|
LIST10(FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO NHYPQ[DX1]), 00061800
|
|
LIST11(SIGQ,FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO DX1), 00061900
|
|
LIST12(J,FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO CLONGQ[DX1]); 00062000
|
|
LABEL DUMMY,L3007,L4021,L4023,L2999,L2019,L9902,L9900,L1,L2; 00062100
|
|
COMMENT 00062200
|
|
THIS SUBROUTINE CONTROLS OUTPUT; 00062300
|
|
TIMINQ(TCCQ); 00062400
|
|
COMMENT 00062500
|
|
PUNCH LAMBDA MATRIX; 00062600
|
|
WRITE(TAPE5,FL3005,LIST1); 00062700
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00062800
|
|
J1Q ~ 1; 00062900
|
|
L3007: J3Q ~ 6|J1Q; 00063000
|
|
J2Q ~ J3Q-5; 00063100
|
|
J3Q ~ MIN(NFACQ,J3Q); 00063200
|
|
WRITE(TAPE5,FL3006,LIST2); 00063300
|
|
J1Q ~ J1Q+1; 00063400
|
|
IF NFACQ>J3Q THEN GO TO L3007; 00063500
|
|
END; 00063600
|
|
WRITE(TAPE5,FL3009); 00063700
|
|
TOTIMQ ~ TOTIMQ/60; 00063800
|
|
COMMENT 00063900
|
|
SET FOR READING TRANSFORMATION MATRIX ON SUBSEQUENT RUN; 00064000
|
|
IPARQ[4] ~ 2; 00064100
|
|
NCYCLEQ ~ NCYCLEQ-KCYCLEQ; 00064200
|
|
NCYCLEQ ~ MAX(0,NCYCLEQ); 00064300
|
|
TIQ ~ TIMEQ; 00064400
|
|
TIMOUTQ(TIQ); 00064500
|
|
TTOTALQ ~ TTOTALQ+TIQ; 00064600
|
|
COMMENT 00064700
|
|
PUNCH CONTINUATION PARAMETER CARD; 00064800
|
|
WRITE(TAPE5,FL10,LIST3); 00064900
|
|
WRITE(LINE,FL3004); 00065000
|
|
COMMENT 00065100
|
|
STORE RESULTS ON TAPE OR DISK IF REQUIRED; 00065200
|
|
IF IPARQ[7]{2 THEN GO TO L4021; 00065300
|
|
WRITE(SW[IPARQ[ 7]],OKTL,NFACQ,NFACQ); 00065400
|
|
FOR DX1~1 STEP 1 UNTIL NFACQ DO 00065500
|
|
WRITE(SW[IPARQ[ 7]],OKTL, FOR 00065600
|
|
DX2~1 STEP 1 UNTIL NFACQ DO COSNQ[DX2,DX1]); 00065700
|
|
L4021: IF IPARQ[3]{2 THEN GO TO L4023; 00065800
|
|
WRITE(SW[IPARQ[ 3]],OKTL,NVARQ,NFACQ); 00065900
|
|
FOR DX1~1 STEP 1 UNTIL NVARQ DO 00066000
|
|
WRITE(SW[IPARQ[ 3]],OKTL, FOR 00066100
|
|
DX2~1 STEP 1 UNTIL NFACQ DO VZEROQ[DX2,DX1]); 00066200
|
|
L4023: IF IPARQ[5]{2 THEN GO TO L2999; 00066300
|
|
WRITE(SW[IPARQ[ 5]],OKTL,NFACQ,NFACQ); 00066400
|
|
FOR DX1~1 STEP 1 UNTIL NFACQ DO 00066500
|
|
WRITE(SW[IPARQ[ 5]],OKTL, FOR 00066600
|
|
DX2~1 STEP 1 UNTIL NFACQ DO CLAMQ[DX2,DX1]); 00066700
|
|
COMMENT 00066800
|
|
PRINT COSINE MATRIX; 00066900
|
|
L2999: WRITE(LINE,FL3002,LIST4); 00067000
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00067100
|
|
COSNQ[K,K] ~ 1; 00067200
|
|
WRITE(LINE,FL2002,LIST5); 00067300
|
|
END; 00067400
|
|
COMMENT 00067500
|
|
PRINT LAMBDA MATRIX; 00067600
|
|
WRITE(LINE,FL2012); 00067700
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00067800
|
|
WRITE(LINE,FL2002,LIST6); 00067900
|
|
END; 00068000
|
|
COMMENT 00068100
|
|
CALCULATE AND PRINT VARIOUS HYPERPLANE PERCENT VALUES; 00068200
|
|
X ~ WIDQ; 00068300
|
|
FOR I ~ 1, I+1 STEP 1 UNTIL 5 DO BEGIN 00068400
|
|
WIDQ ~ I; 00068500
|
|
WIDQ ~ .05|WIDQ; 00068600
|
|
HYPPCQ; 00068700
|
|
WRITE(LINE,FL8010,LIST7); 00068800
|
|
END; 00068900
|
|
WIDQ ~ X; 00069000
|
|
HYPPCQ; 00069100
|
|
COMMENT 00069200
|
|
CALCULATE REFERENCE VECTOR MATRIX; 00069300
|
|
FOR JAQ ~ 1, JAQ+1 STEP 1 UNTIL NVARQ DO BEGIN 00069400
|
|
FOR JBQ ~ 1, JBQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00069500
|
|
V ~ 0; 00069600
|
|
FOR JCQ ~ 1, JCQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00069700
|
|
V ~ V+VZEROQ[JCQ,JAQ]|CLAMQ[JBQ,JCQ] END; 00069800
|
|
VECTORQ[JBQ] ~ V END; 00069900
|
|
FOR JBQ ~ 1, JBQ+1 STEP 1 UNTIL NFACQ DO BEGIN 00070000
|
|
VZEROQ[JBQ,JAQ] ~ VECTORQ[JBQ] END; 00070100
|
|
END; 00070200
|
|
COMMENT 00070300
|
|
PRINT REFERENCE VECTOR MATRIX; 00070400
|
|
WRITE(LINE,FL2014,LIST8); 00070500
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NVARQ DO BEGIN 00070600
|
|
WRITE(LINE,FL2003,LIST9); 00070700
|
|
END; 00070800
|
|
WRITE(LINE,FL2016,LIST10); 00070900
|
|
WRITE(LINE,FL8010,LIST7); 00071000
|
|
IF IPARQ[6]{2 THEN GO TO L2019; 00071100
|
|
WRITE(SW[IPARQ[ 6]],OKTL, NVARQ,NFACQ); 00071200
|
|
FOR DX1~1 STEP 1 UNTIL NVARQ DO 00071300
|
|
WRITE(SW[IPARQ[ 6]],OKTL, FOR 00071400
|
|
DX2~1 STEP 1 UNTIL NFACQ DO VZEROQ[DX2,DX1]); 00071500
|
|
COMMENT 00071600
|
|
PRINT REFERENCE VECTOR MATRIX WITH NON-SALIENTS SUPPRESSED; 00071700
|
|
L2019: WRITE(LINE,FL2015,LIST11); 00071800
|
|
FOR J ~ 1, J+1 STEP 1 UNTIL NVARQ DO BEGIN 00071900
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00072000
|
|
IF ABS(VZEROQ[K,J])}SIGQ THEN GO TO L9902; 00072100
|
|
CLONGQ[K] ~ 0; 00072200
|
|
GO TO L9900; 00072300
|
|
L9902: CLONGQ[K] ~ VZEROQ[K,J]; 00072400
|
|
L9900: END; 00072500
|
|
WRITE(LINE,FL2044,LIST12); 00072600
|
|
END; 00072700
|
|
IF TPLOTQ>0 THEN GO TO L1 ELSE GO TO DUMMY; 00072800
|
|
COMMENT 00072900
|
|
IF PROGRAM TERMINATED FOR LACK OF TIME SUPPRESS PLOT; 00073000
|
|
L1: IPLOTQ ~ 0; 00073100
|
|
L2: GO TO DUMMY; 00073200
|
|
DUMMY: 00073300
|
|
END; 00073400
|
|
00073500
|
|
COMMENT ************************** MXCYCL ****************; 00073600
|
|
PROCEDURE MXCYCLQ; 00073700
|
|
BEGIN 00073800
|
|
OWN REAL EXQ; 00073900
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00074000
|
|
TIMIN, MXROTN, HYPPC; 00074100
|
|
FORMAT FL101(X5,I4,I7,R10.3,X9,I6,X6,I6,X4,R8.1), 00074200
|
|
FL1988(X5,"CYCLE NO.",I4," WITH",I6," HYPERPLANE VARIABLES (", 00074300
|
|
R6.2," PERCENT)."/); 00074400
|
|
LIST LIST1(K,L,TEMQ[L],NHYPQ[K],KOUNT2Q,AHYPPCQ), 00074500
|
|
LIST2(KCYCLEQ,KOUNT2Q,AHYPPCQ); 00074600
|
|
LABEL DUMMY,L1,L50,L10,L2,L4,L5; 00074700
|
|
COMMENT 00074800
|
|
THIS SUBROUTINE CONTROLS THE CYCLING OF THE FACTOR K THAT IS 00074900
|
|
BEING ROTATED; 00075000
|
|
TIMINQ(TCQ); 00075100
|
|
IMPQ ~ 0; 00075200
|
|
COMMENT 00075300
|
|
START ROTATING WITH THE FACTOR THAT IS SPECIFIED; 00075400
|
|
K ~ KSTARTQ; 00075500
|
|
L1: IF ISTABQ[K]>0 THEN GO TO L50 ELSE GO TO L10; 00075600
|
|
COMMENT 00075700
|
|
IF THE FACTOR WAS NOT MOVED LAST TIME SKIP IT FOR JUST THIS CYCLE; 00075800
|
|
L50: ISTABQ[K] ~ 0; 00075900
|
|
GO TO L5; 00076000
|
|
L10: MXROTNQ; 00076100
|
|
IF IMPSQ>0 THEN GO TO L2 ELSE GO TO L5; 00076200
|
|
COMMENT 00076300
|
|
IF A BETTER POSITION WAS FOUND FOR THE FACTOR PRINT HYPERPLANE 00076400
|
|
INFORMATION; 00076500
|
|
L2: HYPPCQ; 00076600
|
|
IMPQ ~ 1; 00076700
|
|
EXQ ~ -1; 00076800
|
|
L ~ KOUNTQ[1]; 00076900
|
|
L4: WRITE(LINE,FL101,LIST1); 00077000
|
|
IF MULTQ{0 THEN GO TO L5; 00077100
|
|
IF L=KOUNTQ[2] THEN GO TO L5; 00077200
|
|
L ~ KOUNTQ[2]; 00077300
|
|
IF L|(NFACQ+1-L){0 THEN GO TO L5; 00077400
|
|
IF TEMQ[L]!0 THEN GO TO L4; 00077500
|
|
L5: K ~ K+1; 00077600
|
|
IF K{NFACQ THEN GO TO L1; 00077700
|
|
KCYCLEQ ~ KCYCLEQ+1; 00077800
|
|
COMMENT 00077900
|
|
AT END OF CYCLE PRINT CYCLE STATISTICS; 00078000
|
|
WRITE(LINE,FL1988,LIST2); 00078100
|
|
GO TO DUMMY; 00078200
|
|
DUMMY: 00078300
|
|
END; 00078400
|
|
00078500
|
|
COMMENT ************************** COSCHK ****************; 00078600
|
|
PROCEDURE COSCHKQ; 00078700
|
|
BEGIN 00078800
|
|
INTEGER DX1; 00078900
|
|
OWN INTEGER NENDQ,I,J; 00079000
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00079100
|
|
MXCYCL, MXTEST, MXOUT, PLOT, MXEND; 00079200
|
|
FORMAT FL100(" COSINES OF ANGLES BETWEEN VECTORS INVALID (GREATER", 00079300
|
|
" THAN",R6.3, 00079400
|
|
"). RUN WILL TERMINATE IF NOT CORRECTED IN 3 CYCLES."///X10, 00079500
|
|
"COSINE MATRIX"/), 00079600
|
|
FL101(/I5,19R6.3/X5,11R6.3), 00079700
|
|
FL103(//X17,"HYPERPLANE COUNT",X5,"HYPERPLANE"/X5, 00079800
|
|
"FACTOR THIS FACTOR ALL FACTORS PER CENT"), 00079900
|
|
FL102(X30, 00080000
|
|
"COSINES WERE NOT CORRECTED IN 3 CYCLES. PROGRAM WILL", 00080100
|
|
" GO TO OUTPUT WITHOUT PLOTTING."//); 00080200
|
|
LIST LIST1(CMAXQ), 00080300
|
|
LIST2(I,FOR DX1 ~ 1 STEP 1 UNTIL NFACQ DO COSNQ[DX1,I]); 00080400
|
|
LABEL DUMMY,L2,L3,L4,L6,L8,L9; 00080500
|
|
COMMENT 00080600
|
|
THIS SUBROUTINE CHECKS THAT THE COSINES BETWEEN THE FACTORS ARE 00080700
|
|
WITHIN THE LIMITS SET BY THE MINIMUM ANGLE RESTRICTION. IF NOT, 00080800
|
|
3 CYCLES ARE ALLOWED TO ADJUST THE ANGLES. IF THERE ARE STILL 00080900
|
|
INVALID ANGLES AFTER 3 CYCLES, THE PROGRAM PROCEEDS TO 00081000
|
|
OUTPUT AND PRODUCTION IS TERMINATED.; 00081100
|
|
NENDQ ~ 0; 00081200
|
|
FOR I ~ 1, I+1 STEP 1 UNTIL NFACQ DO BEGIN 00081300
|
|
FOR J ~ 1, J+1 STEP 1 UNTIL NFACQ DO BEGIN 00081400
|
|
IF ABS(COSNQ[J,I])>CMAXQ THEN GO TO L3 ELSE GO TO L2; 00081500
|
|
COMMENT 00081600
|
|
TEST FOR COSINE TOO LARGE; 00081700
|
|
L2: END; 00081800
|
|
END; 00081900
|
|
GO TO DUMMY; 00082000
|
|
L3: IF NENDQ>0 THEN GO TO L6 ELSE GO TO L4; 00082100
|
|
COMMENT 00082200
|
|
BRANCH IF THIS IS NOT THE FIRST CLEAN-UP CYCLE; 00082300
|
|
L4: NCYCLEQ ~ KCYCLEQ+3; 00082400
|
|
COMMENT 00082500
|
|
SET TO CYCLE FOR 3 CYCLES; 00082600
|
|
NENDQ ~ 1; 00082700
|
|
WRITE(LINE,FL100,LIST1); 00082800
|
|
FOR I ~ 1, I+1 STEP 1 UNTIL NFACQ DO BEGIN 00082900
|
|
WRITE(LINE,FL101,LIST2); 00083000
|
|
END; 00083100
|
|
WRITE(LINE,FL103); 00083200
|
|
L6: MXCYCLQ; 00083300
|
|
MXTESTQ; 00083400
|
|
COMMENT 00083500
|
|
TEST FOR END CONDITION; 00083600
|
|
IF LASTQ{0 THEN GO TO L6; 00083700
|
|
IF NCYCLEQ=KCYCLEQ THEN GO TO L8 ELSE GO TO L9; 00083800
|
|
COMMENT 00083900
|
|
IF END CONDITION ON THIRD CYCLE SUPPRESS PRINT AND GO TO OUTPUT; 00084000
|
|
L8: WRITE(LINE,FL102); 00084100
|
|
IPLOTQ ~ 0; 00084200
|
|
COMMENT 00084300
|
|
IF NOT THIRD CYCLE JUST GO TO OUTPUT; 00084400
|
|
L9: MXOUTQ; 00084500
|
|
PLOTQ; 00084600
|
|
MXENDQ; 00084700
|
|
ERROR(0); 00084800
|
|
DUMMY: 00084900
|
|
END; 00085000
|
|
00085100
|
|
COMMENT ************************** MXZERO ****************; 00085200
|
|
PROCEDURE MXZEROQ; 00085300
|
|
BEGIN 00085400
|
|
INTEGER INDEX1,DX1,DX2; 00085500
|
|
OWN INTEGER N,M,J; 00085600
|
|
OWN REAL V; 00085700
|
|
COMMENT THE FOLLOWING FUNCTIONS ARE REQUIRED: 00085800
|
|
COS; 00085900
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00086000
|
|
PREAD, MXHEAD, COSCHK; 00086100
|
|
FORMAT FL101(12A6), 00086200
|
|
FL100(///// 00086300
|
|
" ***ERROR IN PARAMETERS OR TRANSFORMATION MATRIX - P", 00086400
|
|
"LEASE CHECK"//); 00086500
|
|
FORMAT FL102(I4," VARIABLES",I8," FACTORS --- INPUT MATRIX"); 00086510
|
|
LIST LIST1(FOR INDEX1 ~ 1 STEP 1 UNTIL 12 DO TITLEQ[INDEX1]); 00086600
|
|
LABEL DUMMY,L2,L4,L301,L307,L303,L309,L311,L313,L5069,L5071,L402, 00086700
|
|
L403,L404,L406,L28,L6,L9,L25,L5006,L31,L1003; 00086800
|
|
COMMENT 00086900
|
|
THIS SUBROUTINE READS IN THE FACTOE MATRIX, READS IN THE 00087000
|
|
TRANSFORMATION MATRIX OR GENERATES AN IDENTITY TRANSFORMATION 00087100
|
|
MATRIX, SETS THOSE PARAMETERS THAT ARE UNSPECIFIED TO 00087200
|
|
STANDARD VALUES, AND CALCULATES THE THE VECTOR COSINES.; 00087300
|
|
IF MULTQ>0 THEN GO TO L2; 00087400
|
|
KNQ ~ 0; 00087500
|
|
GO TO L4; 00087600
|
|
L2: KNQ ~ 3; 00087700
|
|
L4: TPLOTQ ~ 0; 00087800
|
|
KSTARTQ ~ MAX(1,KSTARTQ); 00087900
|
|
IF IPLOTQ>2 THEN GO TO L1003; 00088000
|
|
IF KANGQ>2 THEN GO TO L1003; 00088100
|
|
IF WIDQ>0 THEN GO TO L301; 00088200
|
|
WIDQ ~ 0.2; 00088300
|
|
L301: IF SIGQ>0 THEN GO TO L307; 00088400
|
|
SIGQ ~ .25; 00088500
|
|
L307: IF ANFMINQ>0 THEN GO TO L309; 00088600
|
|
ANFMINQ ~ 60; 00088700
|
|
XCLHCQ ~ 50; 00088800
|
|
L303: NCLCYQ ~ 4; 00088900
|
|
GO TO L313; 00089000
|
|
L309: IF XCLHCQ>0 THEN GO TO L311; 00089100
|
|
XCLHCQ ~ 100; 00089200
|
|
L311: IF NCLCYQ{0 THEN GO TO L303; 00089300
|
|
L313: ANGMINQ ~ .0174533|ANFMINQ; 00089400
|
|
ANGQ ~ .1047198; 00089500
|
|
IF (XPR ~ KANGQ-2)>0 THEN GO TO L1003; 00089600
|
|
IF XPR<0 THEN GO TO L5069; 00089700
|
|
ANGQ ~ ANGQ/3; 00089800
|
|
NSHQ ~ 5; 00089900
|
|
GO TO L5071; 00090000
|
|
L5069: NSHQ ~ INT((3.14159-2|ANGMINQ)/ANGQ); 00090100
|
|
L5071: CMAXQ ~ COSQ(ANGMINQ); 00090200
|
|
NCYCLEQ ~ NCYCLEQ+KCYCLEQ; 00090300
|
|
LEGALQ ~ KSWTQ; 00090400
|
|
IF (XPR ~ NCLSPQ)>0 THEN GO TO L403; 00090500
|
|
IF XPR=0 THEN GO TO L402; 00090600
|
|
KHWTQ ~ -5; 00090700
|
|
L402: NCLSPQ ~ NCLCYQ+2; 00090800
|
|
L403: IF (XPR ~ NCLHOQ)>0 THEN GO TO L406; 00090900
|
|
IF XPR=0 THEN GO TO L404; 00091000
|
|
KSWTQ ~ -5; 00091100
|
|
L404: NCLHOQ ~ NCLSPQ; 00091200
|
|
L406: IF UPQ>0 THEN GO TO L28; 00091300
|
|
UPQ ~ 1; 00091400
|
|
COMMENT 00091500
|
|
READ IN TITLE; 00091600
|
|
L28: READ(TAPE7,FL101,LIST1)[FINIS]; 00091700
|
|
IPARQ[2] ~ MAX(IPARQ[2],2); 00091800
|
|
COMMENT 00091900
|
|
READ IN FACTOR MATRIX; 00092000
|
|
READ(SW[IPARQ[ 2]],OKTL,NVARQ,NFACQ); 00092100
|
|
FOR DX1~1 STEP 1 UNTIL NVARQ DO 00092200
|
|
READ(SW[IPARQ[ 2]],OKTL, FOR 00092300
|
|
DX2~1 STEP 1 UNTIL NFACQ DO VZEROQ[DX2,DX1]); 00092400
|
|
WRITE(LINE,FL102,NVARQ,NFACQ); 00092500
|
|
00092600
|
|
FOR DX1~1 STEP 1 UNTIL NVARQ DO 00092700
|
|
WRITE(LINE,<20F6.3>, FOR DX2~1 STEP 1 UNTIL NFACQ DO 00092800
|
|
VZEROQ[DX2,DX1]); 00092900
|
|
IF IPARQ[4]>0 THEN GO TO L6 ELSE GO TO L9; 00093000
|
|
COMMENT 00093100
|
|
READ IN TRANSFORMATION MATRIX IF THERE IS ONE; 00093200
|
|
L6: READ(SW[IPARQ[ 4]],OKTL,N,M); 00093300
|
|
FOR DX1~1 STEP 1 UNTIL N DO 00093400
|
|
READ(SW[IPARQ[ 4]],OKTL, FOR DX2~100093500
|
|
STEP 1 UNTIL M DO CLAMQ[DX2,DX1]); 00093600
|
|
COMMENT 00093700
|
|
CHECK DIMENSIONS; 00093800
|
|
IF N!M THEN GO TO L1003; 00093900
|
|
IF N=NFACQ THEN GO TO L25 ELSE GO TO L1003; 00094000
|
|
COMMENT 00094100
|
|
GENERATE IDENTITY CLAM IF NEEDED; 00094200
|
|
L9: FOR J ~ 1, J+1 STEP 1 UNTIL NFACQ DO BEGIN 00094300
|
|
FOR K ~ 1, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00094400
|
|
CLAMQ[K,J] ~ 0 END; 00094500
|
|
CLAMQ[J,J] ~ 1 END; 00094600
|
|
COMMENT 00094700
|
|
CALCULATE COSINE MATRIX; 00094800
|
|
L25: FOR J ~ 1, J+1 STEP 1 UNTIL NFACQ DO BEGIN 00094900
|
|
KTOTALQ[J] ~ 0; 00095000
|
|
ISTABQ[J] ~ 0; 00095100
|
|
CLONGQ[J] ~ 0; 00095200
|
|
TCOSQ[J] ~ 0; 00095300
|
|
EXANGQ[J] ~ 0; 00095400
|
|
FOR K ~ J, K+1 STEP 1 UNTIL NFACQ DO BEGIN 00095500
|
|
V ~ 0; 00095600
|
|
IF J=K THEN GO TO L5006; 00095700
|
|
FOR L ~ 1, L+1 STEP 1 UNTIL NFACQ DO BEGIN 00095800
|
|
V ~ V+CLAMQ[J,L]|CLAMQ[K,L] END; 00095900
|
|
L5006: COSNQ[J,K] ~ V; 00096000
|
|
COSNQ[K,J] ~ V END; 00096100
|
|
END; 00096200
|
|
MXHEADQ; 00096300
|
|
TOTIMQ ~ TOTIMQ|60; 00096400
|
|
IF (XPR ~ IPLOTQ-2)>0 THEN GO TO L1003; 00096500
|
|
IF XPR=0 THEN GO TO DUMMY; 00096600
|
|
COSCHKQ; 00096700
|
|
L31: GO TO DUMMY; 00096800
|
|
L1003: WRITE(LINE,FL100); 00096900
|
|
COMMENT 00097000
|
|
RETURN PROGRAM CONTROL TO MONITOR SYSTEM WITH ERROR CONDITION; 00097100
|
|
ERROR(0); 00097200
|
|
DUMMY: 00097300
|
|
END; 00097400
|
|
00097500
|
|
COMMENT ************************** MAINPRO ****************; 00097600
|
|
PROCEDURE MAINPRO; 00097700
|
|
BEGIN 00097800
|
|
INTEGER DX1; 00097900
|
|
COMMENT THE FOLLOWING SUBROUTINES ARE REQUIRED: 00098000
|
|
TIMIN, TIME, MXZERO, MXOUT, PLOT, DUMMY, MXCYCL, MXTEST, 00098100
|
|
MXEND, EXTRA; 00098200
|
|
FORMAT FL100(R4.0,11I2,2R3.2,R2.0,I2,R4.1,2I2,3R4.1,2I2,R10.4,2I1), 00098300
|
|
FL101(X30,"***ROTATION TERMINATED"); 00098400
|
|
LIST LIST1(TOTIMQ,FOR DX1 ~ 2 STEP 1 UNTIL 12 DO IPARQ[DX1],WIDQ,SIGQ, 00098500
|
|
ANFMINQ,NCLCYQ,XCLHCQ,NCLSPQ,NCLHOQ,UPQ,PC1Q,PC2Q,KHWTQ,KSWTQ, 00098600
|
|
TTOTALQ,KRAPQ,MULTQ); 00098700
|
|
LABEL L11,L2,L3; 00098800
|
|
L11: TIMINQ(TIMEQ); 00098900
|
|
COMMENT 00099000
|
|
THE PARAMETER CARD IS READ; 00099100
|
|
READ(TAPE7,FL100,LIST1)[FINIS]; 00099200
|
|
KRAPQ ~ ABS(KRAPQ); 00099300
|
|
MULTQ ~ ABS(MULTQ); 00099400
|
|
MXZEROQ; 00099500
|
|
IF IPLOTQ}2 THEN GO TO L2 ELSE GO TO L3; 00099600
|
|
COMMENT 00099700
|
|
IF THIS IS A PLOT ONLY RUN THE PROGRAM PROCEEDS TO OUTPUT; 00099800
|
|
L2: MXOUTQ; 00099900
|
|
PLOTQ; 00100000
|
|
GO TO L11; 00100100
|
|
L3: DUMMYQ; 00100200
|
|
COMMENT 00100300
|
|
DUMMY AND EXTRA, BELOW, ARE SUBROUTINES THAT RETURN CONTROL 00100400
|
|
WITHOUT DOING ANYTHING. THEY ALLOW THE USER TO INSERT HIS OWN 00100500
|
|
SUBROUTINES WHICH WILL WITH MOST COMPUTER SYSTEMS OVERRIDE THE 00100600
|
|
DUMMY SUBROUTINES. A POSSIBLE USE FOR THIS SUBROUTINE, DUMMY, 00100700
|
|
MIGHT BE TO BORDER THE FACTOR OR TRANSFORMATION MATRICES OR TO 00100800
|
|
PERMUTE THE COLUMNS AS MIGHT BE DESIRED WITH KSTART NOT ONE.; 00100900
|
|
MXCYCLQ; 00101000
|
|
MXTESTQ; 00101100
|
|
IF LASTQ{0 THEN GO TO L3; 00101200
|
|
WRITE(LINE,FL101); 00101300
|
|
MXOUTQ; 00101400
|
|
PLOTQ; 00101500
|
|
MXENDQ; 00101600
|
|
EXTRAQ; 00101700
|
|
COMMENT 00101800
|
|
EXTRA IS A DUMMY SUBROUTINE THAT DOES NOTHING BUT ALLOWS THE 00101900
|
|
USER TO INSERT HIS OWN SUBROUTINE, E.G. TO CALCULATE THE FACTOR 00102000
|
|
MATRICES FROM THE REFERENCE VECTOR MATRICES.; 00102100
|
|
GO TO L11; 00102200
|
|
END; 00102300
|
|
00102400
|
|
COMMENT ************************** OUTER BLOCK ************; 00102500
|
|
XPR~QQ~0; 00102600
|
|
SENSL[1]~FALSE; 00102700
|
|
SENSL[2]~FALSE; 00102800
|
|
SENSL[3]~FALSE; 00102900
|
|
SENSL[4]~FALSE; 00103000
|
|
MAINPRO; FINIS: 00103100
|
|
END OF OUTER BLK. 00103200
|
|
LAST CARD ON CRDIMG TAPE 99999999
|