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.
235 lines
16 KiB
Plaintext
235 lines
16 KiB
Plaintext
BEGIN NLCF 1
|
|
|
|
COMMENT LEAST SQUARES CURVE FIT FOR EVALUATING CONSTANTS IN NLCF 2
|
|
NONLINEAR EQUATIONS. NLCF 3
|
|
A. PAUL OLESON NLCF 4
|
|
PROFESSIONAL SERVICES GROUP, BURROUGHS CORP. NLCF 5
|
|
CARD SEQUENCE STARTS WITH NLCF-0001. NLCF 6
|
|
FIRST RELEASE 2-30-63; NLCF 7
|
|
|
|
INTEGER I, J, K, M, N, P, S, V, W, Q, COUNT, ITER ; NLCF 8
|
|
|
|
BOOLEAN P1, P2, RELTV, LVNBG ; NLCF 9
|
|
|
|
REAL TOLA, TOLB ; NLCF 10
|
|
|
|
FILE IN CARD1(1,10) ; NLCF 11
|
|
|
|
FILE OUT CARD4(1,15) ; NLCF 12
|
|
|
|
FORMAT IN CARD2(9I6,2E11.2) ; NLCF 13
|
|
|
|
LIST INTGR(N, M, P, Q, P1, P2, RELTV, LVNBG, ITER, TOLA, TOLB);NLCF 14
|
|
|
|
LABEL START ; NLCF 15
|
|
|
|
COMMENT READ DATA GIVING PROBLEM SIZE ; NLCF 16
|
|
|
|
START: READ (CARD1, CARD2, INTGR) ; NLCF 17
|
|
BEGIN NLCF 18
|
|
|
|
REAL ARRAY G, F, T[0:N], L, U, C, CC, B, BB[0:M], A, R[0:M,0:M], NLCF 19
|
|
X[0:P,0:N], H[0:M,0:N], PH[0:M,0:M,0:N] ; NLCF 20
|
|
|
|
REAL LI, RKI, RR, SD, SE, SS, TEST, TT, OMEGA, Y, TRS1, TRS2, NLCF 21
|
|
TRS3, TRS4, X1S, X2S, X3S ; NLCF 22
|
|
|
|
LABEL FUNC, INT, PRINT ; NLCF 23
|
|
|
|
FORMAT IN CARD3 (5E15.6) ; NLCF 24
|
|
|
|
LIST FNCTN (FOR S ~ 1 STEP 1 UNTIL N DO F[S]), NLCF 25
|
|
VARBL (FOR S ~ 1 STEP 1 UNTIL N DO X[V,S]), NLCF 26
|
|
CONST (FOR I ~ 1 STEP 1 UNTIL M DO B[I]), NLCF 27
|
|
OUT1(COUNT, TT), NLCF 28
|
|
OUT2 (FOR I ~ 1 STEP 1 UNTIL M DO [I, B[I]]), NLCF 29
|
|
OUT3 (FOR S ~ 1 STEP 1 UNTIL N DO [F[S], G[S], T[S]]), NLCF 30
|
|
OUT4 (SD, SE, RR) ; NLCF 31
|
|
|
|
FORMAT OUT HEAD (X15, "ITERATION NO.",X10,"SUM OF SQUARES",X20,"I", NLCF 32
|
|
X15,"B[I]"/), FMT1 (X20, I2, X15, E15.8),NLCF 33
|
|
FMT2 (X72, I1, X8, E15.8), NLCF 34
|
|
FMT3 (/X30, "OBSERVED",X15,"CALCULATED",X15,"DIFFERENCE"),NLCF 35
|
|
FMT4 (X26, E15.8, 2(X10, E15.8)), NLCF 36
|
|
FMT5 (X10, "STANDARD DEVIATION =", E15.8, X5, NLCF 37
|
|
"STANDARD ERROR =", E15.8, X5, "R SQUARE =", E15.8, I2//);NLCF 38
|
|
READ (CARD1, CARD3, FNCTN) ; NLCF 39
|
|
FOR V ~ 1 STEP 1 UNTIL P DO READ (CARD1, CARD3, VARBL) ; NLCF 40
|
|
READ (CARD1, CARD3, CONST) ; NLCF 41
|
|
IF P1 THEN WRITE (CARD4, HEAD) ; NLCF 42
|
|
|
|
COMMENT THE ROUTINE FOR COMPUTING G[S], ITS FIRST DERIVATIVES, NLCF 43
|
|
H[I,S], AND SECOND DERIVATIVES, PH[I,J,S], WITH RESPECT TONLCF 44
|
|
EACH OF THE COEFFICIENTS, B[I], MUST FOLLOW THE DATA READ NLCF 45
|
|
IN. THE ROUTINE LABEL IS FUNC ; NLCF 46
|
|
|
|
FUNC : FOR S ~ 1 STEP 1 UNTIL N DO FUNC 1
|
|
|
|
COMMENT THIS IS THE ROUTINE FOR THE SAMPLE PROBLEM. IT IS REPLACEDFUNC 2
|
|
BY A SUITABLE ROUTINE FOR EACH TYPE OF CORRELATION USED ; FUNC 3
|
|
|
|
BEGIN FUNC 4
|
|
TT ~ X[1,S] ; TRS1 ~ B[3] | TT + B[2] ; FUNC 5
|
|
TRS2 ~ - 1.0 / TRS1 ; TRS3 ~ EXP(TRS2) ; FUNC 6
|
|
TRS4 ~ TRS2 | TRS2 ; Y ~ G[S] ~ B[1] | TRS3 ; FUNC 7
|
|
H[1,S] ~ TRS3 ; TRS2 ~ H[2,S] ~ Y | TRS4 ; FUNC 8
|
|
H[3,S] ~ TT | TRS2 ; PH[1,1,S] ~ 0.0 ; FUNC 9
|
|
TRS2 ~ PH[1,2,S] ~ PH[2,1,S] ~ TRS3 | TRS4 ; FUNC 10
|
|
PH[1,3,S] ~ PH[3,1,S] ~ TT | TRS2 ; FUNC 11
|
|
TRS3 ~ PH[2,2,S] ~ - (TRS1 | 2.0 - 1.0) | Y | TRS4 | TRS4;FUNC 12
|
|
PH[2,3,S] ~ PH[3,2,S] ~ TT | TRS3 ; FUNC 13
|
|
PH[3,3,S] ~ TT | TT | TRS3 FUNC 14
|
|
END ; FUNC 15
|
|
|
|
COUNT ~ COUNT + 1 ; NLCF 47
|
|
IF Q ! 0 THEN NLCF 48
|
|
BEGIN NLCF 49
|
|
TRS1 ~ TRS2 ~ 0.0 ; NLCF 50
|
|
IF RELTV THEN FOR S ~ 1 STEP 1 UNTIL N DO NLCF 51
|
|
BEGIN NLCF 52
|
|
TRS3 ~ G[S] / F[S] ; TRS1 ~ TRS1 + TRS3 ; NLCF 53
|
|
TRS2 ~ TRS3*2 + TRS2 NLCF 54
|
|
END NLCF 55
|
|
ELSE FOR S ~ 1 STEP 1 UNTIL N DO NLCF 56
|
|
BEGIN NLCF 57
|
|
TRS3 ~ G[S] ; TRS1 ~ F[S] | TRS3 + TRS1 ; NLCF 58
|
|
TRS2 ~ TRS3*2 + TRS2 NLCF 59
|
|
END ; NLCF 60
|
|
OMEGA ~ TRS1 / TRS2 ; NLCF 61
|
|
FOR I ~ 1 STEP 1 UNTIL Q DO B[I] ~ B[I] | OMEGA ; NLCF 62
|
|
FOR S ~ 1 STEP 1 UNTIL N DO NLCF 63
|
|
BEGIN NLCF 64
|
|
G[S] ~ G[S] | OMEGA ; NLCF 65
|
|
FOR I ~ Q + 1 STEP 1 UNTIL M DO NLCF 66
|
|
BEGIN NLCF 67
|
|
FOR J ~ Q + 1 STEP 1 UNTIL M DO NLCF 68
|
|
PH[I,J,S] ~ PH[I,J,S] | OMEGA ; NLCF 69
|
|
H[I,S] ~ H[I,S] | OMEGA NLCF 70
|
|
END NLCF 71
|
|
END NLCF 72
|
|
END ; NLCF 73
|
|
TT ~ 0.0 ; FOR S ~ 1 STEP 1 UNTIL N DO NLCF 74
|
|
BEGIN NLCF 75
|
|
SS ~ T[S] ~ F[S] - G[S] ; NLCF 76
|
|
IF RELTV THEN NLCF 77
|
|
BEGIN NLCF 78
|
|
TRS4 ~ 1.0 / F[S] ; NLCF 79
|
|
SS ~ T[S] ~ SS | TRS4 ; NLCF 80
|
|
FOR I ~ 1 STEP 1 UNTIL M DO NLCF 81
|
|
BEGIN NLCF 82
|
|
FOR J ~ I STEP 1 UNTIL M DO PH[I,J,S] ~ PH[I,J,S] | TRS4 ;NLCF 83
|
|
H[I,S] ~ H[I,S] | TRS4 NLCF 84
|
|
END NLCF 85
|
|
END ; NLCF 86
|
|
TT ~ SS | SS + TT NLCF 87
|
|
END ; NLCF 88
|
|
|
|
COMMENT TEST FOR CONVERGENCE. CORRECT DIVERGENCE BY DOUBLING NLCF 89
|
|
DIAGONAL ELEMENTS IN THE COEFFICIENT MATRIX PER LEVENBERG;NLCF 90
|
|
|
|
IF (NOT LVNBG) OR (TEST = 0.0) OR (TT < TEST) THEN NLCF 91
|
|
BEGIN NLCF 92
|
|
FOR I ~ 1 STEP 1 UNTIL M DO FOR J ~ I STEP 1 UNTIL M DO NLCF 93
|
|
BEGIN NLCF 94
|
|
SS ~ 0.0 ; FOR S ~ 1 STEP 1 UNTIL N DO NLCF 95
|
|
A[I,J] ~ SS ~ - PH[I,J,S] | T[S] + H[I,S] | H[J,S] + SS NLCF 96
|
|
END ; NLCF 97
|
|
|
|
COMMENT TEST MATRIX FOR SINGULARITY ; NLCF 98
|
|
|
|
IF A[1,1] = 0.0 THEN NLCF 99
|
|
BEGIN NLCF 100
|
|
I ~ 1 ; FOR I ~ I WHILE A[I,I] = 0.0 DO I ~ I+1 ;NLCF 101
|
|
A[1,1] ~ A[I,I] NLCF 102
|
|
END ; NLCF 103
|
|
FOR I ~ 2 STEP 1 UNTIL M DO IF A[I,I] = 0.0 THEN NLCF 104
|
|
A[I,I] ~ A[I-1,I-1] ; NLCF 105
|
|
|
|
COMMENT CALCULATE THE ELEMENTS OF THE RIGHT HAND SIDE ; NLCF 106
|
|
|
|
FOR I ~ 1 STEP 1 UNTIL M DO NLCF 107
|
|
BEGIN NLCF 108
|
|
SS ~ 0.0 ; FOR S ~ 1 STEP 1 UNTIL N DO NLCF 109
|
|
SS ~ H[I,S] | T[S] + SS ; C[I] ~ SS NLCF 110
|
|
END NLCF 111
|
|
END NLCF 112
|
|
ELSE NLCF 113
|
|
BEGIN NLCF 114
|
|
FOR I ~ 1 STEP 1 UNTIL M DO NLCF 115
|
|
BEGIN NLCF 116
|
|
A[I,I] ~ A[I,I] | 2.0 ; B[I] ~ B[I] - BB[I] NLCF 117
|
|
END ; NLCF 118
|
|
TT ~ TEST NLCF 119
|
|
END ; NLCF 120
|
|
|
|
COMMENT THE CORRECTIONS TO THE CONSTANTS ARE CALCULATED BY CROUTS NLCF 121
|
|
REDUCTION FOR A SYMMETRIC MATRIX ; NLCF 122
|
|
|
|
FOR I ~ 1 STEP 1 UNTIL M DO NLCF 123
|
|
BEGIN NLCF 124
|
|
W ~ I - 1 ; SS ~ A[I,I] ; R[I,I] ~ 1.0 ;NLCF 125
|
|
FOR K ~ 1 STEP 1 UNTIL W DO NLCF 126
|
|
BEGIN NLCF 127
|
|
RKI ~ R[K,I] ; SS ~ - (U[K] ~ L[K] | RKI) | RKI + SSNLCF 128
|
|
END ; NLCF 129
|
|
L[I] ~ SS ; LI ~ 1.0 / SS ; NLCF 130
|
|
FOR J ~ I + 1 STEP 1 UNTIL M DO NLCF 131
|
|
BEGIN NLCF 132
|
|
SS ~ A[I,J] ; FOR K ~ 1 STEP 1 UNTIL W DO NLCF 133
|
|
SS ~ - R[K,J] | U[K] + SS ; R[I,J] ~ SS | LI NLCF 134
|
|
END ; NLCF 135
|
|
SS ~ C[I] ; FOR K ~ 1 STEP 1 UNTIL W DO NLCF 136
|
|
SS ~ - U[K] | CC[K] + SS ; CC[I] ~ SS | LI NLCF 137
|
|
END ; NLCF 138
|
|
BB[M] ~ CC[M] ; FOR I ~ M - 1 STEP -1 UNTIL 1 DO NLCF 139
|
|
BEGIN NLCF 140
|
|
SS ~ CC[I] ; FOR K ~ I + 1 STEP 1 UNTIL M DO NLCF 141
|
|
SS ~ - R[I,K] | BB[K] + SS ; BB[I] ~ SS NLCF 142
|
|
END ; NLCF 143
|
|
|
|
COMMENT TEST ADJUSTMENTS IN CONSTANTS AND THE LAST CHANGE IN THE NLCF 144
|
|
SUM OF SQUARES OF DIFFERENCES ; NLCF 145
|
|
|
|
IF (TEST = TT) OR (ABS(TEST-TT)/TT > TOLA) THEN GO TO INT;NLCF 146
|
|
FOR I ~ 1 STEP 1 UNTIL M DO IF ABS(BB[I]/B[I]) > TOLB THENNLCF 147
|
|
GO TO INT ; GO TO PRINT ; NLCF 148
|
|
|
|
INT : IF P1 THEN NLCF 149
|
|
BEGIN NLCF 150
|
|
WRITE (CARD4, FMT1, OUT1) ; NLCF 151
|
|
WRITE (CARD4, FMT2, OUT2) NLCF 152
|
|
END ; NLCF 153
|
|
IF (COUNT { ITER) OR (LVNBG AND (TEST = TT)) THEN NLCF 154
|
|
BEGIN NLCF 155
|
|
IF (NOT LVNBG) OR (LVNBG AND ((TEST = 0.0) OR TEST > TT)) NLCF 156
|
|
THEN TEST ~ TT ; FOR I ~ 1 STEP 1 UNTIL M DO NLCF 157
|
|
B[I] ~ B[I] + BB[I] ; GO TO FUNC NLCF 158
|
|
END ; NLCF 159
|
|
|
|
PRINT : IF RELTV THEN NLCF 160
|
|
BEGIN NLCF 161
|
|
TT ~ 0.0 ; FOR S ~ 1 STEP 1 UNTIL N DONLCF 162
|
|
BEGIN NLCF 163
|
|
T[S] ~ T[S] | F[S] ; TT ~ T[S] | T[S] + TT NLCF 164
|
|
END NLCF 165
|
|
END ; NLCF 166
|
|
IF P2 THEN NLCF 167
|
|
BEGIN NLCF 168
|
|
WRITE (CARD4, FMT3) ; WRITE (CARD4, FMT4, OUT3) NLCF 169
|
|
END ; NLCF 170
|
|
TEST ~ SS ~ 0.0 ; FOR S ~ 1 STEP 1 UNTIL N DONLCF 171
|
|
BEGIN NLCF 172
|
|
X2S ~ F[S] ; SS ~ X2S + SS ; NLCF 173
|
|
TEST ~ X2S | X2S + TEST NLCF 174
|
|
END ; NLCF 175
|
|
SS ~ SS*2 ; SE ~ SQRT(TT / (N - M)) ; NLCF 176
|
|
SD ~ SQRT((N | TEST - SS) / ((N - 1) | N)); NLCF 177
|
|
RR ~ - (TT / (SD*2 | (N - 1))) + 1.0 ; NLCF 178
|
|
WRITE (CARD4, HEAD) ; WRITE (CARD4, FMT1, OUT1) ;NLCF 179
|
|
WRITE (CARD4, FMT2, OUT2) ; WRITE (CARD4, FMT5, OUT4) ;NLCF 180
|
|
FOR I ~ 1 STEP 1 UNTIL M DO BB[I] ~ 0.0 ; NLCF 181
|
|
TEST ~ COUNT ~ 0.0 NLCF 182
|
|
END ; NLCF 183
|
|
GO TO START ; NLCF 184
|
|
END . NLCF 185
|