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.
254 lines
20 KiB
Plaintext
254 lines
20 KiB
Plaintext
PROCEDURE COMPMATMUL(M, N, P, A, IA, B, IB, C, IC) ; CMXM0001
|
|
CMXM0002
|
|
VALUE M, N, P ; CMXM0003
|
|
INTEGER M, N, P ; CMXM0004
|
|
REAL ARRAY A, IA, B, IB, C, IC[*,*] ; CMXM0005
|
|
CMXM0006
|
|
COMMENT THIS PROCEDURE MULTIPLIES MATRICES WITH COMPLEX ELEMENTS. CMNT0002
|
|
SEE CORREPSONDING TECHNICAL BULLETIN FOR DETAILS ON USE CMNT0003
|
|
OF PROCEDURE. CMNT0004
|
|
CMNT0005
|
|
R.D. RODMAN CMNT0006
|
|
(PROFESSIONAL SERVICES DIVISIONAL GROUP), CMNT0007
|
|
CMNT0008
|
|
CARD SEQUENCE BEGINS WITH CMXM0001, CMNT0009
|
|
FIRST RELEASE 4/1/63 ; CMNT0010
|
|
CMXM0007
|
|
BEGIN CMXM0008
|
|
INTEGER I, J, K; CMXM0009
|
|
REAL ARRAY Q1, Q2[0:1,0:IF M}N AND M}P THEN M ELSE IF N}M AND N}P CMXM0010
|
|
THEN N ELSE P] ; CMXM0011
|
|
PROCEDURE CIP(A, B, N) ; CMXM0012
|
|
CMXM0013
|
|
VALUE N ; CMXM0014
|
|
INTEGER N ; CMXM0015
|
|
ARRAY A, B[0,0] ; CMXM0016
|
|
CMXM0017
|
|
BEGIN CMXM0018
|
|
REAL Q, IQ ; CMXM0019
|
|
INTEGER I ; CMXM0020
|
|
CMXM0021
|
|
Q ~ IQ ~ 0 ; CMXM0022
|
|
CMXM0023
|
|
FOR I ~ 1 STEP 1 UNTIL N DO CMXM0024
|
|
BEGIN CMXM0025
|
|
Q ~ A[0,I] | B[0,I] - A[1,I] | B[1,I] + Q ; CMXM0026
|
|
IQ ~ A[1,I] | B[0,I] + A[0,I] | B[1,I] + IQ CMXM0027
|
|
END ; CMXM0028
|
|
A[0,0] ~ Q ; A[1,0] ~ IQ CMXM0029
|
|
END ; CMXM0030
|
|
CMXM0031
|
|
FOR I ~ 1 STEP 1 UNTIL M DO CMXM0032
|
|
BEGIN CMXM0033
|
|
CMXM0034
|
|
FOR K ~ 1 STEP 1 UNTIL N DO CMXM0035
|
|
BEGIN CMXM0036
|
|
Q1[0,K] ~ A[I,K] ; Q1[1,K] ~ IA[I,K] CMXM0037
|
|
END ; CMXM0038
|
|
CMXM0039
|
|
FOR J ~ 1 STEP 1 UNTIL P DO CMXM0040
|
|
BEGIN CMXM0041
|
|
CMXM0042
|
|
FOR K ~ 1 STEP 1 UNTIL N DO CMXM0043
|
|
BEGIN CMXM0044
|
|
Q2[0,K] ~ B[K,J] ; Q2[1,K] ~ IB[K,J] CMXM0045
|
|
END ; CMXM0046
|
|
CIP(Q1, Q2, N) ; CMXM0047
|
|
C[I,J] ~ Q1[0,0] ; IC[I,J] ~ Q1[1,0] CMXM0048
|
|
END CMXM0049
|
|
END CMXM0050
|
|
END ; CMXM0051
|
|
PROCEDURE COMPINV(N, A, IA, EPS, SINGULAR) ; CINV0001
|
|
CINV0002
|
|
VALUE N, EPS ; CINV0003
|
|
INTEGER N ; CINV0004
|
|
REAL EPS ; CINV0005
|
|
ARRAY A, IA[0,0] ; CINV0006
|
|
LABEL SINGULAR ; CINV0007
|
|
CINV0008
|
|
COMMENT THIS PROCEDURE INVERTS A MATRIX OF COMPLEX ELEMENTS. CMNT0002
|
|
SEE CORRESPONDING TECHNICAL BULLETIN FOR DETAILS ON USE CMNT0003
|
|
OF THE PROCEDURE. CMNT0004
|
|
CMNT0005
|
|
R.D. RODMAN CMNT0006
|
|
(PROFESSIONAL SERVICES DIVISIONAL GROUP), CMNT0007
|
|
CMNT0008
|
|
CARD SEQUENCE BEGINS WITH CINV0001, CMNT0009
|
|
FIRST RELEASE 4/1/63 ; CMNT0010
|
|
CINV0009
|
|
BEGIN CINV0010
|
|
INTEGER I, Z, K, L, K2, J, V, Y, W ; CINV0011
|
|
REAL BIG, T, EPS, TEMP, DIAG, IT ; CINV0012
|
|
ARRAY Q1[0:1,0:N], Q2[0:1,0:N] ; CINV0013
|
|
INTEGER ARRAY F[0:N] ; CINV0014
|
|
PROCEDURE CIP(A, B, N) ; CINV0015
|
|
CINV0016
|
|
VALUE N ; CINV0017
|
|
INTEGER N ; CINV0018
|
|
CINV0020
|
|
BEGIN CINV0021
|
|
ARRAY A, B[0,0] ; CINV0019
|
|
REAL Q, IQ ; CINV0022
|
|
INTEGER I ; CINV0023
|
|
CINV0024
|
|
Q ~ IQ ~ 0 ; CINV0025
|
|
CINV0026
|
|
FOR I ~ 1 STEP 1 UNTIL N DO CINV0027
|
|
BEGIN CINV0028
|
|
Q ~ A[0,I] | B[0,I] - A[1,I] | B[1,I] + Q ; CINV0029
|
|
IQ ~ A[1,I] | B[0,I] + A[0,I] | B[1,I] + IQ CINV0030
|
|
END ; CINV0031
|
|
A[0,0] ~ Q ; A[1,0] ~ IQ CINV0032
|
|
END ; CINV0033
|
|
CINV0034
|
|
FOR I ~ 1 STEP 1 UNTIL N DO CINV0035
|
|
BEGIN CINV0036
|
|
Z ~ I-1 ; CINV0037
|
|
CINV0038
|
|
FOR K ~ 1 STEP 1 UNTIL Z DO CINV0039
|
|
BEGIN CINV0040
|
|
Q1[0,K] ~ A[K,I] ; Q1[1,K] ~ IA[K,I] CINV0041
|
|
END ; CINV0042
|
|
CINV0043
|
|
FOR K ~ I STEP 1 UNTIL N DO CINV0044
|
|
BEGIN CINV0045
|
|
CINV0046
|
|
FOR L ~ 1 STEP 1 UNTIL Z DO CINV0047
|
|
BEGIN CINV0048
|
|
Q2[0,L] ~ A[K,L] ; Q2[1,L] ~ IA[K,L] CINV0049
|
|
END ; CINV0050
|
|
CIP(Q1, Q2, Z) ; CINV0051
|
|
A[K,I] ~ A[K,I] - Q1[0,0] ; IA[K,I] ~ IA[K,I] - Q1[1,0] CINV0052
|
|
END ; CINV0053
|
|
BIG ~ 0 ; K2 ~ I ; CINV0054
|
|
CINV0055
|
|
FOR K ~ I STEP 1 UNTIL N DO CINV0056
|
|
BEGIN CINV0057
|
|
T ~ A[K,I]*2 + IA[K,I]*2 ; CINV0058
|
|
IF T > BIG THEN CINV0059
|
|
BEGIN CINV0060
|
|
BIG ~ T ; K2 ~ K CINV0061
|
|
END CINV0062
|
|
END ; CINV0063
|
|
IF BIG { EPS THEN GO TO SINGULAR ; CINV0064
|
|
F[I] ~ K2 ; CINV0065
|
|
IF K2 ! I THEN FOR K ~ 1 STEP 1 UNTIL N DO CINV0066
|
|
BEGIN CINV0067
|
|
TEMP ~ A[I,K] ; A[I,K] ~ A[K2,K] ; A[K2,K] ~ TEMP ; CINV0068
|
|
TEMP ~ IA[I,K] ; IA[I,K] ~ IA[K2,K] ; IA[K2,K] ~ TEMP CINV0069
|
|
END ; CINV0070
|
|
DIAG ~ 1/(A[I,I]*2 + IA[I,I]*2) ; CINV0071
|
|
CINV0072
|
|
FOR K ~ 1 STEP 1 UNTIL Z DO CINV0073
|
|
BEGIN CINV0074
|
|
Q1[0,K] ~ A[I,K] ; Q1[1,K] ~ IA[I,K] CINV0075
|
|
END ; CINV0076
|
|
CINV0077
|
|
FOR K ~ I+1 STEP 1 UNTIL N DO CINV0078
|
|
BEGIN CINV0079
|
|
CINV0080
|
|
FOR L ~ 1 STEP 1 UNTIL Z DO CINV0081
|
|
BEGIN CINV0082
|
|
Q2[0,L] ~ A[L,K] ; Q2[1,L] ~ IA[L,K] CINV0083
|
|
END ; CINV0084
|
|
CIP(Q1, Q2, Z) ; CINV0085
|
|
T ~ A[I,K] - Q1[0,0] ; IT ~ IA[I,K] - Q1[1,0] ; CINV0086
|
|
A[I,K] ~(T|A[I,I] + IT|IA[I,I]) | DIAG ; CINV0087
|
|
IA[I,K] ~ (IT|A[I,I] - T|IA[I,I]) | DIAG CINV0088
|
|
END CINV0089
|
|
END ; CINV0090
|
|
CINV0091
|
|
FOR I ~ 1 STEP 1 UNTIL N DO CINV0092
|
|
BEGIN CINV0093
|
|
DIAG ~ 1/(A[I,I]*2 + IA[I,I]*2) ; Z ~ I-1 ; CINV0094
|
|
CINV0095
|
|
FOR J ~ 1 STEP 1 UNTIL I DO CINV0096
|
|
BEGIN CINV0097
|
|
IF I ! J THEN CINV0098
|
|
BEGIN CINV0099
|
|
CINV0100
|
|
FOR K ~ J STEP 1 UNTIL Z DO CINV0101
|
|
BEGIN CINV0102
|
|
Q1[0,K-J+1] ~ A[K,J] ; Q1[1,K-J+1] ~ IA[K,J] ; CINV0103
|
|
Q2[0,K-J+1] ~ A[I,K] ; Q2[1,K-J+1] ~ IA[I,K] CINV0104
|
|
END ; CINV0105
|
|
CIP(Q1, Q2, I-J) ; CINV0106
|
|
A[I,J] ~ (-Q1[0,0]|A[I,I] - Q1[1,0]|IA[I,I]) | DIAG ; CINV0107
|
|
IA[I,J] ~ (Q1[0,0]|IA[I,I]- Q1[1,0]|A[I,I]) |DIAG CINV0108
|
|
END CINV0109
|
|
ELSE CINV0110
|
|
BEGIN CINV0111
|
|
A[I,I] ~ A[I,I] | DIAG ; CINV0112
|
|
IA[I,I] ~ -IA[I,I] | DIAG CINV0113
|
|
END CINV0114
|
|
END CINV0115
|
|
END ; CINV0116
|
|
V ~ N-1 ; CINV0117
|
|
CINV0118
|
|
FOR I ~ V STEP -1 UNTIL 1 DO CINV0119
|
|
BEGIN CINV0120
|
|
Z ~ I+1 ; CINV0121
|
|
CINV0122
|
|
FOR J ~ N STEP -1 UNTIL Z DO CINV0123
|
|
BEGIN CINV0124
|
|
Y ~ J-1 ; CINV0125
|
|
CINV0126
|
|
FOR K ~ I+1 STEP 1 UNTIL Y DO CINV0127
|
|
BEGIN CINV0128
|
|
Q1[0,W~K-I] ~ A[K,J] ; Q1[1,W] ~ IA[K,J] ; CINV0129
|
|
Q2[0,W] ~ A[I,K] ; Q2[1,W] ~ IA[I,K] CINV0130
|
|
END ; CINV0131
|
|
CIP(Q1, Q2, Y-I) ; CINV0132
|
|
A[I,J] ~ -A[I,J] - Q1[0,0] ; CINV0133
|
|
IA[I,J] ~ -IA[I,J] - Q1[1,0] CINV0134
|
|
END CINV0135
|
|
END ; CINV0136
|
|
CINV0137
|
|
FOR I ~ 1 STEP 1 UNTIL V DO CINV0138
|
|
BEGIN CINV0139
|
|
CINV0140
|
|
FOR J ~ 1 STEP 1 UNTIL N DO CINV0141
|
|
BEGIN CINV0142
|
|
IF I } J THEN CINV0143
|
|
BEGIN CINV0144
|
|
CINV0145
|
|
FOR K ~ I+1 STEP 1 UNTIL N DO CINV0146
|
|
BEGIN CINV0147
|
|
Q1[0,K-I] ~ A[I,K] ; Q1[1,K-I] ~ IA[I,K] ; CINV0148
|
|
Q2[0,K-I] ~ A[K,J] ; Q2[1,K-I] ~ IA[K,J] CINV0149
|
|
END ; CINV0150
|
|
CIP(Q1, Q2, N-I) ; CINV0151
|
|
A[I,J] ~ A[I,J] + Q1[0,0] ; CINV0152
|
|
IA[I,J] ~ IA[I,J] + Q1[1,0] CINV0153
|
|
END CINV0154
|
|
ELSE CINV0155
|
|
BEGIN CINV0156
|
|
CINV0157
|
|
FOR K ~ J STEP 1 UNTIL N DO CINV0158
|
|
BEGIN CINV0159
|
|
Q1[0,W~K-J+1] ~ A[K,J] ; Q1[1,W] ~ IA[K,J] ; CINV0160
|
|
Q2[0,W] ~ A[I,K] ; Q2[1,W] ~ IA[I,K] CINV0161
|
|
END ; CINV0162
|
|
CIP(Q1, Q2, N-J+1) ; CINV0163
|
|
A[I,J] ~ Q1[0,0] ; IA[I,J] ~ Q1[1,0] CINV0164
|
|
END CINV0165
|
|
END CINV0166
|
|
END ; CINV0167
|
|
CINV0168
|
|
FOR J ~ N STEP -1 UNTIL 1 DO CINV0169
|
|
BEGIN CINV0170
|
|
IF F[J] ! J THEN CINV0171
|
|
BEGIN CINV0172
|
|
K2 ~ F[J] ; CINV0173
|
|
CINV0174
|
|
FOR K ~ 1 STEP 1 UNTIL N DO CINV0175
|
|
BEGIN CINV0176
|
|
TEMP ~ A[K,K2] ; A[K,K2] ~ A[K,J] ; A[K,J] ~ TEMP ; CINV0177
|
|
TEMP ~ IA[K,K2] ; IA[K,K2] ~ IA[K,J] ; IA[K,J] ~ TEMP CINV0178
|
|
END CINV0179
|
|
END CINV0180
|
|
ELSE CINV0181
|
|
END CINV0182
|
|
END ; CINV0183
|
|
|