retro-software.B5500-software/CUBE-Library-13/Files/LSQFOUR-E200002.alg

COMMENT        PROCEDURE - LEAST SQUARE FOURIER,                        00000100
               CUBE LIBRARY NUMBER IS E200002.                          00000200
               THIS VERSION DATED 2/1/67;                               00000300
PROCEDURE FOURIERS(N,D,DT,Y,X,TEST,A);COMMENT N=NUMBER OF POINTS,D=DEGRE00000400
E,DT=DELTA,Y=ARRAY OF DATA POINTS,X=ZERO ORDINATE,IF TEST=0 CALCULATES 200000500
D+1 FOURIER SERIES COEFFICIENTS,SINES AND COSINES PRESENT,IF TEST=1 CALC00000600
ULATES COEFFICIENTS OF SERIES CONSISTING OF SINE TERMS ONLY,IF TEST=2 CL00000700
ACULATES COEFFICIENTS OF A SERIES CONSISTING OF COSINE TERMS ONLY A=OUTP00000800
UT ARRAY;VALUE N,D,DT,X,TEST;INTEGER N,D,TEST;REAL DT,X;REAL ARRAY Y,A[100000900
,1];BEGIN COMMENT THIS PROCEDURE WILL COMPUTE THE INVERSE OF A SYMMETRIC00001000
 MATRIX.THE PROCEDURE WILL FAIL IF ANY "TRAILING MINOR"IS ZERO.THIS COND00001100
ITION CANNOT EXITS IF THE MATRIX IS "DEFINITE".UPON ENTERING THE PROCEDU00001200
RE THE DIAGONAL ELEMENTS OF THE ORIGINAL MATRIX ARE PLACED IN A VECTOR C00001300
ALLED "DIAGONAL".THE INVERSE MATRIX IS PLACED IN THE UPPER TRIANGULAR HA00001400
LF,INCLUDING THE MAIN DIAGONAL,OF THE ORIGINAL ARRAY.R.D.RODMAN,(PROFESS00001500
IONAL SERVICES GROUP),CARD SEQUENCE STARTS WITH "ISYM0010",FIRST RELEASE00001600
 12/01/62.;PROCEDURE INVPDS(N,A,DIAGONAL);VALUE N ;INTEGER N ;REAL ARRAY00001700
 A[1,1],DIAGONAL[1];BEGIN INTEGER I,J,K,I1,L ;REAL DIAG,Q ;REAL ARRAY TE00001800
MP[0:N];LABEL IN1,IN2,IN3 ;COMMENT THE ORIGINAL MATRIX IS DECOMPOSED INT00001900
O THE PRODUCT OF A UNIT LOWER TRIANGULAR MATRIX,A DIAGONAL MATRIX,AND A 00002000
UNIT UPPER TRIANGULAR MATRIX WHICH IS THE TRANSPOSE OF THE UNIT LOWER TR00002100
IANGULAR MATRIX.;IN1:FOR I ~N STEP -1 UNTIL 1 DO BEGIN DIAGONAL[I]~A[I,I00002200
];FOR K ~I+1 STEP 1 UNTIL N DO TEMP[K]~A[I,K]|A[K,K];FOR J ~I STEP -1 UN00002300
TIL 1 DO BEGIN Q~0 ;FOR K ~I+1 STEP 1 UNTIL N DO Q ~A[J,K]|TEMP[K]+Q ;IF00002400
 I=J THEN A[J,I]~DIAG ~A[J,I]-Q ELSE A[J,I]~(A[J,I]-Q)/DIAG END END ;COM00002500
MENT THESE THREE MATRICES ARE INVERTED.;IN2:FOR I ~N STEP -1 UNTIL 1 DO 00002600
BEGIN I1 ~I+1 ;A[I,I]~1.0 /A[I,I];FOR J ~N STEP -1 UNTIL I1 DO BEGIN Q~000002700
 ;L ~J-1 ;FOR K ~I1 STEP 1 UNTIL L DO Q ~A[I,K]|A[K,J]+Q ;A[I,J]~-A[I,J]00002800
-Q END END ;COMMENT THE INVERTED MATRICES ARE MULTIPLIED,IN REVERSE ORDE00002900
R,TO GIVE THE DESIRED INVERSE.;IN3:FOR I ~N STEP -1 UNTIL 1 DO BEGIN I1 00003000
~I-1 ;DIAG ~A[I,I];FOR K ~1 STEP 1 UNTIL I1 DO TEMP[K]~A[K,K]|A[K,I];FOR00003100
 J ~N STEP -1 UNTIL I DO BEGIN Q~0 ;FOR K ~1 STEP 1 UNTIL I1 DO Q ~A[K,J00003200
]|TEMP[K]+Q ;A[J,I]~A[I,J]~IF I=J THEN A[I,J]+Q ELSE A[I,J]|DIAG +Q END 00003300
END END ;PROCEDURE MATATB (A,B,N1,N2,N4,C);VALUE N1,N2,N4;INTEGER N1,N2,00003400
N4;REAL ARRAY A,B,C[1,1];BEGIN INTEGER I,J,K;REAL ARRAY E[1:N2,1:N1];FOR00003500
 I~1 STEP 1 UNTIL N1 DO FOR J~1 STEP 1 UNTIL N2 DO E[J,I]~A[I,J];FOR K~100003600
 STEP 1 UNTIL N4 DO FOR I~1 STEP 1 UNTIL N2 DO BEGIN C[I,K]~0;FOR J~1 ST00003700
EP 1 UNTIL N1 DO C[I,K]~E[I,J]|B[J,K]+C[I,K]END;END;PROCEDURE MATMPY (A,00003800
B,N1,N2,N4,C);VALUE N1,N2,N4;INTEGER N1,N2,N4;REAL ARRAY A,B,C[1,1];BEGI00003900
N INTEGER I,J,K;FOR K~1 STEP 1 UNTIL N4 DO FOR I~1 STEP 1 UNTIL N1 DO BE00004000
GIN C[I,K]~0;FOR J~1 STEP 1 UNTIL N2 DO C[I,K]~A[I,J]|B[J,K]+C[I,K]END;E00004100
ND;PROCEDURE MATTP (A,N1,N2,C);VALUE N1,N2;INTEGER N1,N2;REAL ARRAY A,C[00004200
1,1];BEGIN INTEGER I,J;FOR I~1 STEP 1 UNTIL N1 DO FOR J~1 STEP 1 UNTIL N00004300
2 DO C[J,I]~A[I,J];END;LABEL L1,L2,L3;LABEL OFF;REAL SDT,CDT;SWITCH BOB~00004400
L1,L2,L3;SDT~SIN (DT);CDT ~COS (DT);GO TO BOB[TEST];L1:BEGIN COMMENT THI00004500
S COMPUTES SINE AND COSINE COEFF;REAL ARRAY S,C[1:N,1:D+1],B[1:N,1:2|D+100004600
];INTEGER I,J;REAL ARRAY F[1:2|D+1,1:1],R[1:2|D+1,1:2|D+1],DG[1:2|D+1];R00004700
EAL ARRAY Z[1:N,1:1];FOR I~1 STEP 1 UNTIL N DO BEGIN S[I,1]~0;C[I,1]~1 E00004800
ND;B[1,D+2]~S[1,2]~SIN (X);B[1,2]~C[1,2]~COS(X);FOR I~1 STEP 1 UNTIL N D00004900
O B[I,1]~1;FOR I~2 STEP 1 UNTIL N DO BEGIN C[I,2]~B[I,2]~B[I-1,2]|CDT -B00005000
[I-1,D+2]|SDT;S[I,2]~B[I,D+2]~B[I-1,D+2]|CDT +B[I-1,2]|SDT END;FOR J~1 S00005100
TEP 1 UNTIL N DO FOR I~2 STEP 1 UNTIL D DO BEGIN B[J,I+1]~C[J,I+1]~2|B[J00005200
,I]|B[J,2]-C[J,I-1];B[J,I+D+1]~S[J,I+1]~2 |B[J,I+D ]|B[J,2]-S[J,I-1]END;00005300
MATATB (B,B,N,(2|D)+1,(2|D)+1,R);MATTP (Y,1,N,Z);MATATB (B,Z,N,(2|D)+1,100005400
,F);INVPDS ((2|D)+1,R,DG);MATMPY (R,F,(2|D)+1,(2|D)+1,1,A)END;GO TO OFF;00005500
L2:BEGIN COMMENT COMPUTES COEFF WITH ONLY COSINE TERMS PRESENT;REAL ARRA00005600
Y B[1:N,1:D+1],S[1:N,1:1];INTEGER I,J;REAL ARRAY R[1:D+1,1:D+1],Z[1:N,1:00005700
1],F[1:D+1,1:1],DG[1:D+1];S[1,1]~SIN (X);B[1,2]~COS (X);FOR I~1 STEP 1 U00005800
NTIL N DO B[I,1]~1;FOR I~2 STEP 1 UNTIL N DO BEGIN B[I,2]~B[I-1,2]|CDT -00005900
S[I-1,1]|SDT;S[I,1]~S[I-1,1]|CDT +B[I-1,2]|SDT END;FOR J~1 STEP 1 UNTIL 00006000
N DO FOR I~2 STEP 1 UNTIL D DO B[J,I+1]~2 |B[J,I]|B[J,2]-B[J,I-1];MATATB00006100
 (B,B,N,D+1,D+1,R);MATTP (Y,1,N,Z);MATATB (B,Z,N,D+1,1,F);INVPDS (D+1,R,00006200
DG);MATMPY (R,F,D+1,D+1,1,A);GO TO OFF;END;L3:BEGIN COMMENT COMPUTES COE00006300
FF WITH ONLY SINE TERMS PRESENT;REAL ARRAY B[1:N,1:D],C[1:N,1:D+1];INTEG00006400
ER I,J;REAL ARRAY R[1:D,1:D],Z[1:N,1:1],F[1:D,1:1],DG[1:D];C[1,2]~COS (X00006500
);B[1,1]~SIN (X);FOR I~1 STEP 1 UNTIL N DO C[I,1]~0;FOR I~2 STEP 1 UNTIL00006600
 N DO BEGIN B[I,1]~B[I-1,1]|CDT +C[I-1,2]|SDT;C[I,2]~C[I-1,2]|CDT -B[I-100006700
,1]|SDT END;FOR I~1 STEP 1 UNTIL N DO B[I,2]~2 |B[I,1]|C[I,2];FOR J~1 ST00006800
EP 1 UNTIL N DO FOR I~3 STEP 1 UNTIL D DO B[J,I]~2|B[J,I-1]|C[J,2]-B[J,I00006900
-2];MATATB (B,B,N,D,D,R);MATTP (Y,1,N,Z);MATATB (B,Z,N,D,1,F);INVPDS (D,00007000
R,DG);MATMPY (R,F,D,D,1,A)END;OFF:END;                                  00007100