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.
130 lines
10 KiB
Plaintext
130 lines
10 KiB
Plaintext
|
|
COMMENT PROCEDURE TRIDIAG REDUCES A REAL SYMMETRIC MATRIX A TEST0001
|
|
OF ORDER N TO TRIDIAGONAL FORM (UT)AU (UT = TRANSPOSE TEST0002
|
|
OF U) BY GIVENS METHOD. TEST0003
|
|
ALSO, THE MATRIX U IS CALCULATED. TEST0004
|
|
TEST0005
|
|
GERARD F. DIETZEL TEST0006
|
|
PROFESSIONAL SERVICES GROUP, BURROUGHS CORPORATION. TEST0007
|
|
TEST0008
|
|
PROCEDURE CARD SEQUENCE BEGINS WITH TRID-0001 TEST0009
|
|
FIRST RELEASE DATE 5-14-1962 ; TEST0010
|
|
TEST0011
|
|
BEGIN TEST0012
|
|
TEST0013
|
|
INTEGER N ; TEST0014
|
|
LIST ORDER(N) ; TEST0015
|
|
FORMAT IN FIN1(I1) ; TEST0016
|
|
FILE IN CARD(1,10) ; TEST0017
|
|
FILE OUT PRINT(1,15) ; TEST0018
|
|
TEST0019
|
|
READ(CARD,FIN1,ORDER) ; TEST0020
|
|
TEST0021
|
|
BEGIN TEST0022
|
|
TEST0023
|
|
INTEGER I,J ; TEST0024
|
|
ARRAY A,U[0:N,0:N] ; TEST0025
|
|
TEST0026
|
|
LIST MATRIX(FOR J ~ I STEP 1 UNTIL N DO A[I,J]), TEST0027
|
|
MATRIN(I, FOR J ~ 1 STEP 1 UNTIL N DO [J,A[I,J]]), TEST0028
|
|
MATRUTAU(I, FOR J ~ 1 STEP 1 UNTIL N DO [J,A[I,J]]), TEST0029
|
|
MATRU(I, FOR J ~ 1 STEP 1 UNTIL N DO [J,U[I,J]]) ; TEST0030
|
|
TEST0031
|
|
FORMAT IN FIN2(4(F4.1,X2)) ; TEST0032
|
|
TEST0033
|
|
FORMAT OUT FOUT(X15,"ROW",I3/X15,"COLUMN"/(X15,5(I4,F15.8))), TEST0034
|
|
HEADING1(//X55,"INPUT MATRIX A"//), TEST0035
|
|
HEADING2(//X55,"TRIDIAGONAL MATRIX (UT)AU"//), TEST0036
|
|
HEADING3(//X55,"MATRIX U"//) ; TEST0037
|
|
TEST0038
|
|
PROCEDURE TRIDIAG(N,A,U) ; TRID0001
|
|
TRID0002
|
|
VALUE N ; TRID0003
|
|
INTEGER N ; TRID0004
|
|
ARRAY A,U[0,0] ; TRID0005
|
|
TRID0006
|
|
BEGIN TRID0007
|
|
INTEGER I,J,J1,J2,J3,J4,K,N1 ; TRID0008
|
|
REAL FACT,C1,C2,LOC1,LOC2,TEMP ; TRID0009
|
|
LABEL L ; TRID0010
|
|
TRID0011
|
|
COMMENT SET MATRIX U = IDENTITY MATRIX OF ORDER N ; TRID0012
|
|
FOR I ~ 1 STEP 1 UNTIL N DO TRID0013
|
|
BEGIN TRID0014
|
|
FOR J ~ I+1 STEP 1 UNTIL N DO TRID0015
|
|
U[I,J] ~ U[J,I] ~ 0 ; TRID0016
|
|
U[I,I] ~ 1.0 TRID0017
|
|
END ; TRID0018
|
|
TRID0019
|
|
COMMENT THE REDUCTION OF THE MATRIX A BEGINS HERE. TRID0020
|
|
ONLY THE UPPER TRIANGULAR ELEMENTS OF A ARE USED TRID0021
|
|
IN THE COMPUTATION ; TRID0022
|
|
TRID0023
|
|
N1 ~ N - 2 ; TRID0024
|
|
FOR I ~ 1 STEP 1 UNTIL N1 DO TRID0025
|
|
BEGIN TRID0026
|
|
TRID0027
|
|
J1 ~ I + 1 ; J2 ~ I + 2 ; TRID0028
|
|
FOR J ~ J2 STEP 1 UNTIL N DO TRID0029
|
|
BEGIN TRID0030
|
|
IF A[I,J] = 0 THEN GO TO L ; TRID0031
|
|
FACT ~ 1 / SQRT(A[I,J1]*2 + A[I,J]*2) ; TRID0032
|
|
C1 ~ FACT | A[I,J1] ; C2 ~ FACT | A[I,J] ; TRID0033
|
|
LOC1 ~ A[J1,J1] ; LOC2 ~ A[J1,J] ; TRID0034
|
|
A[J1,J1] ~ C1*2|LOC1 + 2.0|C1|C2|LOC2 + C2*2|A[J,J] ; TRID0035
|
|
A[J1,J] ~ -C1|C2|LOC1 + (C1*2 - C2*2)|LOC2 + C1|C2|A[J,J];TRID0036
|
|
A[J,J] ~ C2*2|LOC1 - 2.0|C1|C2|LOC2 + C1*2|A[J,J] ; TRID0037
|
|
TRID0038
|
|
J3 ~ J + 1 ; TRID0039
|
|
FOR K ~ J3 STEP 1 UNTIL N DO TRID0040
|
|
BEGIN TRID0041
|
|
TEMP ~ A[J1,K] ; TRID0042
|
|
A[J1,K] ~ C1|TEMP + C2|A[J,K] ; TRID0043
|
|
A[J,K] ~ -C2|TEMP + C1|A[J,K] TRID0044
|
|
END ; TRID0045
|
|
TRID0046
|
|
J4 ~ J - 1 ; TRID0047
|
|
FOR K ~ J2 STEP 1 UNTIL J4 DO TRID0048
|
|
BEGIN TRID0049
|
|
TEMP ~ A[J1,K] ; TRID0050
|
|
A[J1,K] ~ C1|TEMP + C2|A[K,J] ; TRID0051
|
|
A[K,J] ~ -C2|TEMP + C1|A[K,J] TRID0052
|
|
END ; TRID0053
|
|
TRID0054
|
|
A[I,J1] ~ C1|A[I,J1] + C2|A[I,J] ; TRID0055
|
|
A[I,J] ~ 0 ; TRID0056
|
|
TRID0057
|
|
FOR K ~ 1 STEP 1 UNTIL N DO TRID0058
|
|
BEGIN TRID0059
|
|
TEMP ~ U[K,J1] ; TRID0060
|
|
U[K,J1] ~ C1|TEMP + C2|U[K,J] ; TRID0061
|
|
U[K,J] ~ -C2|TEMP + C1|U[K,J] TRID0062
|
|
END ; TRID0063
|
|
TRID0064
|
|
L: END TRID0065
|
|
TRID0066
|
|
END ; TRID0067
|
|
TRID0068
|
|
FOR I ~ 1 STEP 1 UNTIL N DO TRID0069
|
|
FOR J ~ I+1 STEP 1 UNTIL N DO TRID0070
|
|
A[J,I] ~ A[I,J] TRID0071
|
|
END ; TRID0072
|
|
TEST0039
|
|
FOR I ~ 1 STEP 1 UNTIL N DO READ(CARD,FIN2,MATRIX) ; TEST0040
|
|
WRITE(PRINT,HEADING1) ; TEST0041
|
|
FOR I ~ 1 STEP 1 UNTIL N DO TEST0042
|
|
FOR J ~ I+1 STEP 1 UNTIL N DO TEST0043
|
|
A[J,I] ~ A[I,J] ; TEST0044
|
|
FOR I ~ 1 STEP 1 UNTIL N DO WRITE(PRINT,FOUT,MATRIN) ; TEST0045
|
|
TEST0046
|
|
TRIDIAG(N,A,U) ; TEST0047
|
|
TEST0048
|
|
WRITE(PRINT,HEADING2) ; TEST0049
|
|
FOR I ~ 1 STEP 1 UNTIL N DO WRITE(PRINT,FOUT,MATRUTAU) ;TEST0050
|
|
WRITE(PRINT,HEADING3) ; TEST0051
|
|
FOR I ~ 1 STEP 1 UNTIL N DO WRITE(PRINT,FOUT,MATRU) TEST0052
|
|
TEST0053
|
|
END TEST0054
|
|
TEST0055
|
|
END. TEST0056
|