"COMMENT" ================== 34010 =================; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "VALUE" L,U,SHIFT; "INTEGER" L,U,SHIFT; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[K] * B[SHIFT + K] + S; VECVEC:= S "END" VECVEC; "COMMENT" ================== 34011 =================; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "VALUE" L,U,I; "INTEGER" L,U,I; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[I,K] * B[K] + S; MATVEC:= S "END" MATVEC; "COMMENT" ================== 34012 =================; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "VALUE" L,U,I; "INTEGER" L,U,I; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[K,I] * B[K] + S; TAMVEC:= S "END" TAMVEC; "COMMENT" ================== 34013 =================; "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "VALUE" L,U,I,J; "INTEGER" L,U,I,J; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[I,K] * B[K,J] + S; MATMAT:= S "END" MATMAT; "COMMENT" ================== 34014 =================; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "VALUE" L,U,I,J; "INTEGER" L,U,I,J; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[K,I] * B[K,J] + S; TAMMAT:= S "END" TAMMAT; "COMMENT" ================== 34015 =================; "REAL" "PROCEDURE" MATTAM(L, U, I, J, A, B); "VALUE" L,U,I,J; "INTEGER" L,U,I,J; "ARRAY" A,B; "BEGIN" "INTEGER" K; "REAL" S; S:= 0; "FOR" K:=L "STEP" 1 "UNTIL" U "DO" S:= A[I,K] * B[J,K] + S; MATTAM:= S "END" MATTAM; "COMMENT" ================== 34016 =================; "REAL" "PROCEDURE" SEQVEC(L, U, IL, SHIFT, A, B); "VALUE" L,U,IL,SHIFT; "INTEGER" L,U,IL,SHIFT; "ARRAY" A,B; "BEGIN" "REAL" S; S:= 0; "FOR" L:=L "STEP" 1 "UNTIL" U "DO" "BEGIN" S:= A[IL] * B[L + SHIFT] + S; IL:= IL + L "END"; SEQVEC:= S "END" SEQVEC; "COMMENT" ================== 34017 =================; "REAL" "PROCEDURE" SCAPRD1(LA, SA, LB, SB, N, A, B); "VALUE" LA,SA,LB,SB,N; "INTEGER" LA,SA,LB,SB,N; "ARRAY" A,B; "BEGIN" "REAL" S;"INTEGER" K; S:= 0; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" S:=A[LA] * B[LB] + S; LA:= LA + SA; LB:= LB + SB "END"; SCAPRD1:= S "END" SCAPRD1; "COMMENT" ================== 34018 =================; "REAL" "PROCEDURE" SYMMATVEC(L, U, I, A, B); "VALUE" L,U,I; "INTEGER" L,U,I; "ARRAY" A,B; "BEGIN" "INTEGER" K, M; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "REAL" "PROCEDURE" SEQVEC(L, U, IL, SHIFT, A, B); "CODE" 34016; M:= "IF" L > I "THEN" L "ELSE" I; K:= M * (M - 1) // 2; SYMMATVEC:= VECVEC(L, "IF" I <= U "THEN" I-1 "ELSE" U, K, B, A) + SEQVEC(M, U, K + I, 0, A, B) "END" SYMMATVEC; "COMMENT" ================== 31500 =================; "PROCEDURE" FULMATVEC(LR, UR, LC, UC, A, B, C); "VALUE" LR, UR, LC, UC, B; "INTEGER" LR, UR, LC, UC; "ARRAY" A, B, C; "BEGIN" "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" C[LR]:= MATVEC(LC, UC, LR, A, B); "END" FULMATVEC; "COMMENT" ================== 31501 =================; "PROCEDURE" FULTAMVEC(LR, UR, LC, UC, A, B, C); "VALUE" LR, UR, LC, UC, B; "INTEGER" LR, UR, LC, UC; "ARRAY" A, B, C; "BEGIN" "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" C[LC]:= TAMVEC(LR, UR, LC, A, B); "END" FULTAMVEC; "COMMENT" ================== 31502 =================; "PROCEDURE" FULSYMMATVEC(LR, UR, LC, UC, A, B, C); "VALUE" LR, UR, LC, UC, B; "INTEGER" LR, UR, LC, UC; "ARRAY" A, B, C; "BEGIN" "REAL" "PROCEDURE" SYMMATVEC(L, U, I, A, B); "CODE" 34018; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" C[LR]:= SYMMATVEC(LC, UC, LR, A, B) "END" FULSYMMATVEC; "COMMENT" ================== 31503 =================; "PROCEDURE" RESVEC(LR, UR, LC, UC, A, B, C, X); "VALUE" LR, UR, LC, UC, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" A, B, C; "BEGIN" "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" C[LR]:= MATVEC(LC, UC, LR, A, B) + C[LR] * X "END" RESVEC; "COMMENT" ================== 31504 =================; "PROCEDURE" SYMRESVEC(LR, UR, LC, UC, A, B, C, X); "VALUE" LR, UR, LC, UC, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" A, B, C; "BEGIN" "REAL" "PROCEDURE" SYMMATVEC(L, U, I, A, B); "CODE" 34018; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" C[LR]:= SYMMATVEC(LC, UC, LR, A, B) + C[LR] * X "END" SYMRESVEC; "COMMENT" ================== 34214 =================; "REAL" "PROCEDURE" RNK1MIN(N, X, G, H, FUNCT, IN, OUT); "VALUE" N; "INTEGER" N; "ARRAY" X, G, H, IN, OUT; "REAL" "PROCEDURE" FUNCT; "BEGIN" "INTEGER" I, IT, N2, CNTL, CNTE, EVL, EVLMAX; "BOOLEAN" OK; "REAL" F, F0, FMIN, MU, DG, DG0, GHG, GS, NRMDELTA, ALFA, MACHEPS, RELTOL, ABSTOL, EPS, TOLG, ORTH, AID; "ARRAY" V, DELTA, GAMMA, S, P[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; "REAL" "PROCEDURE" SYMMATVEC(L, U, I, A, B); "CODE" 34018; "PROCEDURE" INIVEC(L, U, A, X); "CODE" 31010; "PROCEDURE" INISYMD(LR, UR, SHIFT, A, X); "CODE" 31013; "PROCEDURE" MULVEC(L, U, SHIFT, A, B, X); "CODE" 31020; "PROCEDURE" DUPVEC(L, U, SHIFT, A, B); "CODE" 31030; "PROCEDURE" EIGSYM1(A, N, NUMVAL, VAL, VEC, EM); "CODE" 34156; "PROCEDURE" LINEMIN(N, X, D, ND, A, G, F, F0, F1, DFO, DF1, E, S, IN); "CODE" 34210; "PROCEDURE" RNK1UPD(H, N, V, C); "CODE" 34211; "PROCEDURE" DAVUPD(H, N, V, W, C1, C2); "CODE" 34212; "PROCEDURE" FLEUPD(H, N, V, W, C1, C2); "CODE" 34213; MACHEPS:= IN[0]; RELTOL:= IN[1]; ABSTOL:= IN[2]; MU:= IN[3]; TOLG:= IN[4]; FMIN:= IN[5]; IT := 0; ALFA:= IN[6]; EVLMAX:= IN[7]; ORTH:= IN[8]; N2:= N * (N + 1) // 2; CNTL:= CNTE:= 0; "IF" ALFA > 0 "THEN" "BEGIN" INIVEC(1, N2, H, 0); INISYMD(1, N, 0, H, ALFA) "END"; F:= FUNCT(N, X, G); EVL:= 1; DG:= SQRT(VECVEC(1, N, 0, G, G)); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DELTA[I]:= - SYMMATVEC(1, N, I, H, G); NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)); DG0:= VECVEC(1, N, 0, DELTA, G); OK:= DG0 < 0; EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL; "FOR" IT:= IT + 1 "WHILE" (NRMDELTA > EPS "OR" DG > TOLG "OR" ^ OK) "AND" EVL < EVLMAX "DO" "BEGIN" "IF" ^OK "THEN" "BEGIN" "ARRAY" VEC[1:N,1:N], TH[1:N2], EM[0:9]; EM[0]:= MACHEPS; EM[2]:= AID:= SQRT(MACHEPS * RELTOL); EM[4]:= ORTH; EM[6]:= AID * N; EM[8]:= 5; CNTE:= CNTE + 1; DUPVEC(1, N2, 0, TH, H); EIGSYM1(TH,N,N,V,VEC,EM); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" AID:= - TAMVEC(1, N, I, VEC, G); S[I]:= AID * ABS(V[I]); V[I]:= AID * SIGN(V[I]) "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DELTA[I]:= MATVEC(1, N, I, VEC, S); P[I]:= MATVEC(1, N, I, VEC, V) "END"; DG0:= VECVEC(1, N, 0, DELTA, G); NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)) "END" CALCULATING GREENSTADTS DIRECTION; DUPVEC(1, N, 0, S, X); DUPVEC(1, N, 0, V, G); "IF" IT > N "THEN" ALFA:= 1 "ELSE" "BEGIN" "IF" IT ^= 1 "THEN" ALFA:= ALFA / NRMDELTA "ELSE" "BEGIN" ALFA:= 2 * (FMIN - F) / DG0; "IF" ALFA > 1 "THEN" ALFA:= 1 "END" "END"; ELMVEC(1, N, 0, X, DELTA, ALFA); F0:= F; F:= FUNCT(N, X, G); EVL:= EVL +1 ; DG:= VECVEC(1, N, 0, DELTA, G); "IF" IT = 1 "OR" F0 - F < -MU * DG0 * ALFA "THEN" "BEGIN" I:= EVLMAX - EVL; CNTL:= CNTL +1 ; LINEMIN(N, S, DELTA, NRMDELTA, ALFA, G, FUNCT, F0, F, DG0, DG, I, "FALSE", IN); EVL:= EVL + I; DUPVEC(1, N, 0, X, S); "END" LINEMINIMIZATION; DUPVEC(1, N, 0, GAMMA, G); ELMVEC(1, N, 0, GAMMA, V, -1); "IF" ^ OK "THEN" MULVEC(1, N, 0, V, P, -1); DG:= DG - DG0; "IF" ALFA ^= 1 "THEN" "BEGIN" MULVEC(1, N, 0, DELTA, DELTA, ALFA); MULVEC(1, N, 0, V, V, ALFA); NRMDELTA:= NRMDELTA * ALFA; DG:= DG * ALFA "END"; DUPVEC(1, N, 0, P, GAMMA); ELMVEC(1, N, 0, P, V, 1); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" V[I]:= SYMMATVEC(1, N, I, H, GAMMA); DUPVEC(1, N, 0, S, DELTA); ELMVEC(1, N, 0, S, V, -1); GS:= VECVEC(1, N, 0, GAMMA, S); GHG:= VECVEC(1, N, 0, V, GAMMA); AID:= DG / GS; "IF" VECVEC(1, N, 0, DELTA, P) ** 2 > VECVEC(1, N, 0, P, P) * (ORTH * NRMDELTA) ** 2 "THEN" RNK1UPD(H, N, S, 1 / GS) "ELSE" "IF" AID >= 0 "THEN" FLEUPD(H, N, DELTA, V, 1 / DG, (1 + GHG / DG) / DG) "ELSE" DAVUPD(H, N, DELTA, V, 1 / DG, 1 / GHG); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DELTA[I]:= -SYMMATVEC(1, N, I, H, G); ALFA:= NRMDELTA; NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)); EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL; DG:= SQRT(VECVEC(1, N, 0, G, G)); DG0:= VECVEC(1, N, 0, DELTA, G); OK:= DG0 <= 0 "END" ITERATION; OUT[0]:= NRMDELTA; OUT[1]:= DG; OUT[2]:= EVL; OUT[3]:= CNTL; OUT[4]:= CNTE; RNK1MIN:= F "END" RNK1MIN; "COMMENT" ================== 34215 =================; "REAL" "PROCEDURE" FLEMIN(N, X, G, H, FUNCT, IN, OUT); "VALUE" N; "INTEGER" N; "ARRAY" X, G, H, IN, OUT; "REAL" "PROCEDURE" FUNCT; "BEGIN" "INTEGER" I, IT, CNTL, EVL, EVLMAX; "REAL" F,F0,FMIN,MU,DG,DG0,NRMDELTA,ALFA,RELTOL,ABSTOL, EPS, TOLG, AID; "ARRAY" V, DELTA, S[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; "REAL" "PROCEDURE" SYMMATVEC(L, U, I, A, B); "CODE" 34018; "PROCEDURE" INIVEC(L, U, A, X); "CODE" 31010; "PROCEDURE" INISYMD(LR, UR, SHIFT, A, X); "CODE" 31013; "PROCEDURE" MULVEC(L, U, SHIFT, A, B, XB); "CODE" 31020; "PROCEDURE" DUPVEC(L, U, SHIFT, A, B); "CODE" 31030; "PROCEDURE" LINEMIN(N, X, D, ND, A, G, F, F0, F1, DF0, DF1, E, S, IN); "CODE" 34210; "PROCEDURE" DAVUPD(H, N, V, W, C1, C2); "CODE" 34212; "PROCEDURE" FLEUPD(H, N, V, W, C1, C2); "CODE" 34213; RELTOL:= IN[1]; ABSTOL:= IN[2]; MU:= IN[3]; TOLG:= IN[4]; FMIN:= IN[5]; ALFA:= IN[6]; EVLMAX:= IN[7]; OUT[4]:= 0; IT := 0; F:= FUNCT(N, X, G); EVL:= 1; CNTL:= 0;"IF" ALFA > 0 "THEN" "BEGIN" INIVEC(1, N * (N + 1) // 2, H, 0); INISYMD(1, N, 0, H, ALFA) "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DELTA[I]:= - SYMMATVEC(1, N, I, H, G); DG:= SQRT(VECVEC(1, N, 0, G, G)); NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)); EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL; DG0:= VECVEC(1, N, 0, DELTA, G); "FOR" IT := IT +1 "WHILE" (NRMDELTA > EPS "OR" DG > TOLG ) "AND" EVL < EVLMAX "DO" "BEGIN" DUPVEC(1, N, 0, S, X); DUPVEC(1, N, 0, V, G); "IF" IT >= N "THEN" ALFA:= 1 "ELSE" "BEGIN" "IF" IT ^= 1 "THEN" ALFA:= ALFA / NRMDELTA "ELSE" "BEGIN" ALFA:= 2 * (FMIN - F) / DG0; "IF" ALFA > 1 "THEN" ALFA:= 1 "END" "END"; ELMVEC(1, N, 0, X, DELTA, ALFA); F0:= F; F:= FUNCT(N, X, G); EVL:= EVL +1 ; DG:= VECVEC(1, N, 0, DELTA, G); "IF" IT = 1 "OR" F0 - F < - MU * DG0 * ALFA "THEN" "BEGIN" I:= EVLMAX - EVL; CNTL:= CNTL +1 ; LINEMIN(N, S, DELTA, NRMDELTA, ALFA, G, FUNCT, F0, F, DG0, DG, I, "FALSE", IN); EVL:= EVL + I; DUPVEC(1, N, 0, X, S); "END" LINEMINIMIZATION; "IF" ALFA ^= 1 "THEN" MULVEC(1, N, 0, DELTA, DELTA, ALFA); MULVEC(1, N, 0, V, V, -1); ELMVEC(1, N, 0, V, G, 1); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" S[I]:= SYMMATVEC(1, N, I, H, V); AID:= VECVEC(1, N, 0, V, S); DG:= (DG - DG0) * ALFA; "IF" DG > 0 "THEN" "BEGIN" "IF" DG >= AID "THEN" FLEUPD(H, N, DELTA, S, 1 / DG, (1 + AID / DG) / DG) "ELSE" DAVUPD(H, N, DELTA, S, 1 / DG, 1 / AID) "END" UPDATING; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DELTA[I]:= -SYMMATVEC(1, N, I, H, G); ALFA:= NRMDELTA * ALFA; NRMDELTA:= SQRT(VECVEC(1, N, 0, DELTA, DELTA)); EPS:= SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL; DG:= SQRT(VECVEC(1, N, 0, G, G)); DG0:= VECVEC(1, N, 0, DELTA, G); "IF" DG0 > 0 "THEN" "BEGIN" OUT[4]:= -1 ; "GOTO" EXIT "END" "END" ITERATION; EXIT: OUT[0]:= NRMDELTA; OUT[1]:= DG; OUT[2]:= EVL; OUT[3]:= CNTL; FLEMIN:= F "END" FLEMIN; "COMMENT" ================== 34352 =================; "PROCEDURE" COMCOLCST(L,U,J,AR,AI,XR,XI); "VALUE" L,U,J,XR,XI;"INTEGER" L,U,J;"REAL" XR,XI; "ARRAY" AR,AI; "BEGIN" "PROCEDURE" COMMUL(AR,AI,BR,BI,RR,RI);"CODE" 34341; "FOR" L:=L "STEP" 1 "UNTIL" U "DO" COMMUL(AR[L,J],AI[L,J],XR,XI,AR[L,J],AI[L,J]); "END" COMCOLCST; "COMMENT" ================== 34353 =================; "PROCEDURE" COMROWCST(L, U, I, AR, AI, XR, XI); "VALUE" L, U, I, XR, XI; "INTEGER" L, U, I; "REAL" XR, XI; "ARRAY" AR, AI; "BEGIN" "PROCEDURE" COMMUL(AR,AI,BR,BI,RR,RI);"CODE" 34341; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" COMMUL(AR[I,L], AI[I,L], XR, XI, AR[I,L], AI[I,L]); "END" COMROWCST; "COMMENT" ================== 34354 =================; "PROCEDURE" COMMATVEC(L, U, I, AR, AI, BR, BI, RR, RI); "VALUE" L, U, I; "INTEGER" L, U, I; "REAL" RR, RI; "ARRAY" AR, AI, BR, BI; "BEGIN" "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);"CODE" 34011; "REAL" MV; MV:= MATVEC(L, U, I, AR, BR) - MATVEC(L, U, I, AI, BI); RI:= MATVEC(L, U, I, AI, BR) + MATVEC(L, U, I, AR, BI); RR:=MV "END" COMMATVEC; "COMMENT" ================== 34355 =================; "BOOLEAN" "PROCEDURE" HSHCOMCOL(L, U, J, AR, AI, TOL, K, C, S, T); "VALUE" L, U, J, TOL; "INTEGER" L, U, J; "REAL" TOL, K, C, S, T; "ARRAY" AR, AI; "BEGIN" "REAL" VR, DEL, MOD, H, ARLJ, AILJ; "PROCEDURE" CARPOL(AR,AI,R,C,S);"CODE" 34344; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; VR:= TAMMAT(L + 1, U, J, J, AR, AR) + TAMMAT(L + 1, U, J, J, AI, AI); ARLJ:= AR[L,J]; AILJ:= AI[L,J]; CARPOL(ARLJ, AILJ, MOD, C, S); "IF" VR > TOL "THEN" "BEGIN" VR:= VR + ARLJ ** 2 + AILJ ** 2; H:= K:= SQRT(VR); T:= VR + MOD * H; "IF" ARLJ = 0 "AND" AILJ = 0 "THEN" AR[L,J]:= H "ELSE" "BEGIN" AR[L,J]:= ARLJ + C * K; AI[L,J]:= AILJ + S * K; S:= - S "END"; C:= - C; HSHCOMCOL:= "TRUE" "END" "ELSE" "BEGIN" HSHCOMCOL:= "FALSE"; K:= MOD; T:= - 1 "END" "END" HSHCOMCOL; "COMMENT" ================== 34356 =================; "PROCEDURE" HSHCOMPRD(I, II, L, U, J, AR, AI, BR, BI, T); "VALUE" I, II, L, U, J, T; "INTEGER" I, II, L, U, J; "REAL" T; "ARRAY" AR, AI, BR, BI; "BEGIN" "PROCEDURE" ELMCOMCOL(L,U,I,J,AR,AI,BR,BI,XR,XI);"CODE" 34377; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" ELMCOMCOL(I, II, L, J, AR, AI, BR, BI, ( - TAMMAT(I, II, J, L, BR, AR) - TAMMAT(I, II, J, L, BI, AI)) / T, (TAMMAT(I, II, J, L, BI, AR) - TAMMAT(I, II, J, L, BR, AI)) / T); "END" HSHCOMPRD; "COMMENT" ================== 34376 =================; "PROCEDURE" ELMCOMVECCOL(L,U,J,AR,AI,BR,BI,XR,XI); "VALUE" L,U,J,XR,XI; "INTEGER" L,U,J;"REAL" XR,XI;"ARRAY" AR,AI,BR,BI; "BEGIN" "PROCEDURE" ELMVECCOL(L,U,I,A,B,X);"CODE" 34021; ELMVECCOL(L,U,J,AR,BR,XR); ELMVECCOL(L,U,J,AR,BI,-XI); ELMVECCOL(L,U,J,AI,BR,XI); ELMVECCOL(L,U,J,AI,BI,XR) "END" ELMCOMVECCOL; "COMMENT" ================== 34377 =================; "PROCEDURE" ELMCOMCOL(L,U,I,J,AR,AI,BR,BI,XR,XI); "VALUE" L,U,I,J,XR,XI; "INTEGER" L,U,I,J;"REAL" XR,XI;"ARRAY" AR,AI,BR,BI; "BEGIN" "PROCEDURE" ELMCOL(L,U,I,J,A,B,X);"CODE" 34023; ELMCOL(L,U,I,J,AR,BR,XR); ELMCOL(L,U,I,J,AR,BI,-XI); ELMCOL(L,U,I,J,AI,BR,XI); ELMCOL(L,U,I,J,AI,BI,XR) "END" ELMCOMCOL; "COMMENT" ================== 34378 =================; "PROCEDURE" ELMCOMROWVEC(L,U,I,AR,AI,BR,BI,XR,XI); "VALUE" L,U,I,XR,XI; "INTEGER" L,U,I;"REAL" XR,XI;"ARRAY" AR,AI,BR,BI; "BEGIN" "PROCEDURE" ELMROWVEC(L,U,I,A,B,X);"CODE" 34027; ELMROWVEC(L,U,I,AR,BR,XR); ELMROWVEC(L,U,I,AR,BI,-XI); ELMROWVEC(L,U,I,AI,BR,XI); ELMROWVEC(L,U,I,AI,BI,XR) "END" ELMCOMROWVEC; "COMMENT" ================== 34360 =================; "PROCEDURE" SCLCOM(AR, AI, N, N1, N2); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" AR, AI; "BEGIN" "INTEGER" I, J, K; "REAL" S, R; "PROCEDURE" COMCOLCST(L,U,J,AR,AI,XR,XI);"CODE" 34352; "FOR" J:= N1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" S:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" R:= AR[I,J] ** 2 + AI[I,J] ** 2; "IF" R > S "THEN" "BEGIN" S:= R; K:= I "END" "END"; "IF" S ^= 0 "THEN" COMCOLCST(1, N, J, AR, AI, AR[K,J] / S, - AI[K,J] / S) "END" "END" SCLCOM; "COMMENT" ================== 34359 =================; "REAL" "PROCEDURE" COMEUCNRM(AR, AI, LW, N); "VALUE" N, LW; "INTEGER" N, LW; "ARRAY" AR, AI; "BEGIN" "INTEGER" I, L; "REAL" "PROCEDURE" MATTAM(L,U,I,J,A,B);"CODE" 34015; "REAL" R; R:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" L:= "IF" I > LW "THEN" I - LW "ELSE" 1; R:= MATTAM(L, N, I, I, AR, AR) + MATTAM(L, N, I, I, AI, AI) + R; "END"; COMEUCNRM:= SQRT(R) "END" COMEUCNRM; "COMMENT" ================== 34340 =================; "REAL" "PROCEDURE" COMABS(XR,XI);"VALUE" XR,XI;"REAL" XR,XI; "BEGIN" XR:= ABS(XR); XI:= ABS(XI); COMABS:= "IF" XI > XR "THEN" SQRT((XR/XI)**2+1)*XI "ELSE" "IF" XI= 0 "THEN" XR "ELSE" SQRT((XI/XR)**2+1)*XR "END" COMABS; "COMMENT" ================== 34343 =================; "PROCEDURE" COMSQRT(AR,AI,PR,PI); "VALUE" AR,AI; "REAL" AR,AI,PR,PI; "IF" AR=0 & AI= 0 "THEN" PR:= PI:=0 "ELSE" "BEGIN" "REAL" BR,BI,H; BR:= ABS(AR); BI:= ABS(AI); H:= "IF" BI < BR "THEN" ("IF" BR<1 "THEN" SQRT((SQRT((BI/BR)**2+1)*.5+.5)*BR) "ELSE" SQRT((SQRT((BI/BR)**2+1)*.125+.125)*BR)*2) "ELSE" "IF" BI<1 "THEN" SQRT((SQRT((BR/BI)**2+1)*BI+BR)*2)*.5 "ELSE" "IF" BR+1= 1 "THEN" SQRT(BI*.5) "ELSE" SQRT(SQRT((BR/BI)**2+1)*BI*.125+BR*.125)*2; "IF" AR >= 0 "THEN" "BEGIN" PR:= H; PI:= AI/H*.5 "END" "ELSE" "BEGIN" PI:= "IF" AI >= 0 "THEN" H "ELSE" -H; PR:= BI/H*.5 "END" "END" COMSQRT; "COMMENT" ================== 34342 =================; "PROCEDURE" COMDIV(XR,XI,YR,YI,ZR,ZI); "VALUE" XR,XI,YR,YI;"REAL" XR,XI,YR,YI,ZR,ZI; "BEGIN" "REAL" H,D; "IF" ABS(YI) < ABS(YR) "THEN" "BEGIN" "IF" YI= 0 "THEN" "BEGIN" ZR:= XR/YR; ZI:= XI/YR "END" "ELSE" "BEGIN" H:= YI/YR; D:= H*YI + YR; ZR:= (XR + H * XI)/D; ZI:= (XI-H*XR)/D "END" "END" "ELSE" "BEGIN" H:= YR/YI; D:= H*YR + YI; ZR:= (XR*H + XI)/D; ZI:= (XI*H - XR)/D "END" "END" COMDIV; "COMMENT" ================== 34301 =================; "PROCEDURE" DECSOL(A, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX, B; "BEGIN" "INTEGER" "ARRAY" P[1:N]; "PROCEDURE" SOL(A, N, P, B); "CODE" 34051; "PROCEDURE" DEC(A, N, AUX, P); "CODE" 34300; DEC(A, N, AUX, P); "IF" AUX[3] = N "THEN" SOL(A, N, P, B) "END" DECSOL; "COMMENT" ================== 34061 =================; "PROCEDURE" SOLELM(A, N, RI, CI, B); "VALUE" N; "INTEGER" N; "ARRAY" A, B; "INTEGER" "ARRAY" RI, CI; "BEGIN" "INTEGER" R, CIR; "REAL" W; "PROCEDURE" SOL(A, N, P, B); "CODE" 34051; SOL(A, N, RI, B); "FOR" R:= N "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" CIR:= CI[R]; "IF" CIR ^= R "THEN" "BEGIN" W:= B[R]; B[R]:= B[CIR]; B[CIR]:= W "END" "END" "END" SOLELM; "COMMENT" ================== 34243 =================; "PROCEDURE" GSSSOLERB(A, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX, B; "BEGIN" "INTEGER" "ARRAY" RI, CI[1:N]; "PROCEDURE" SOLELM(A, N, RI, CI, B); "CODE" 34061; "PROCEDURE" GSSERB(A, N, AUX, RI, CI); "CODE" 34242; GSSERB(A, N, AUX, RI, CI); "IF" AUX[3] = N "THEN" SOLELM(A, N, RI, CI, B) "END" GSSSOLERB; "COMMENT" ================== 34302 =================; "PROCEDURE" DECINV(A, N, AUX); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX; "BEGIN" "INTEGER" "ARRAY" P[1:N]; "PROCEDURE" DEC(A, N, AUX, P); "CODE" 34300; "PROCEDURE" INV(A, N, P); "CODE" 34053; DEC(A, N, AUX, P); "IF" AUX[3] = N "THEN" INV(A, N, P) "END" DECINV; "COMMENT" ================== 34236 =================; "PROCEDURE" GSSINV(A, N, AUX); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX; "BEGIN" "INTEGER" "ARRAY" RI, CI[1:N]; "PROCEDURE" GSSELM(A, N, AUX, RI, CI); "CODE" 34231; "REAL" "PROCEDURE" INV1(A, N, RI, CI, WITHNORM); "CODE" 34235; GSSELM(A, N, AUX, RI, CI); "IF" AUX[3] = N "THEN" AUX[9]:= INV1(A, N, RI, CI, "TRUE") "END" GSSINV; "COMMENT" ================== 34244 =================; "PROCEDURE" GSSINVERB(A, N, AUX); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX; "BEGIN" "INTEGER" "ARRAY" RI, CI[1:N]; "PROCEDURE" GSSELM(A, N, AUX, RI, CI); "CODE" 34231; "REAL" "PROCEDURE" INV1(A, N, RI, CI, WITHNORM); "CODE" 34235; "PROCEDURE" ERBELM(N, AUX, NRMINV); "CODE" 34241; GSSELM(A, N, AUX, RI, CI); "IF" AUX[3] = N "THEN" ERBELM(N, AUX, INV1(A, N, RI, CI, "TRUE")) "END" GSSINVERB; "COMMENT" ================== 34251 =================; "PROCEDURE" GSSITISOL(A, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX, B; "BEGIN" "INTEGER" I, J; "ARRAY" AA[1:N,1:N]; "INTEGER" "ARRAY" RI, CI[1:N]; "PROCEDURE" GSSELM(A, N, AUX, RI, CI); "CODE" 34231; "PROCEDURE" ITISOL(A, LU, N, AUX, RI, CI, B); "CODE" 34250; "PROCEDURE" DUPMAT(L, U, I, J, A, B); "CODE" 31035; DUPMAT(1, N, 1, N, AA, A); GSSELM(A, N, AUX, RI, CI); "IF" AUX[3] = N "THEN" ITISOL(AA, A, N, AUX, RI, CI, B) "END" GSSITISOL; "COMMENT" ================== 34254 =================; "PROCEDURE" GSSITISOLERB(A, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" A, AUX, B; "BEGIN" "INTEGER" I, J; "ARRAY" AA[1:N,1:N]; "INTEGER" "ARRAY" RI, CI[1:N]; "PROCEDURE" GSSNRI(A, N, AUX, RI, CI); "CODE" 34252; "PROCEDURE" ITISOLERB(A, LU, N, AUX, RI, CI, B); "CODE" 34253; "PROCEDURE" DUPMAT(L, U, I, J, A, B); "CODE" 31035; DUPMAT(1, N, 1, N, AA, A); GSSNRI(A, N, AUX, RI, CI); "IF" AUX[3] = N "THEN" ITISOLERB(AA, A, N, AUX, RI, CI, B) "END" GSSITISOLERB; "COMMENT" ================== 34131 =================; "PROCEDURE" LSQSOL(A, N, M, AID, CI, B); "VALUE" N, M; "INTEGER" N, M; "ARRAY" A, AID, B; "INTEGER" "ARRAY" CI; "BEGIN" "INTEGER" K, CIK; "REAL" W; "REAL""PROCEDURE" MATVEC(L, U, I, A, B);"CODE" 34011; "REAL""PROCEDURE" TAMVEC(L, U, I, A, B);"CODE" 34012; "PROCEDURE" ELMVECCOL(L, U, I, A, B, X);"CODE" 34021; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" ELMVECCOL(K, N, K, B, A, TAMVEC(K, N, K, A, B) / (AID[K] * A[K,K])); "FOR" K:= M "STEP" - 1 "UNTIL" 1 "DO" B[K]:= (B[K] - MATVEC (K + 1, M, K, A, B)) / AID[K]; "FOR" K:= M "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" CIK:= CI[K]; "IF" CIK ^= K "THEN" "BEGIN" W:= B[K]; B[K]:= B[CIK]; B[CIK]:= W "END" "END" "END" LSQSOL; "COMMENT" ================== 34135 =================; "PROCEDURE" LSQORTDECSOL(A, N, M, AUX, DIAG, B); "VALUE" N, M; "INTEGER" N, M; "ARRAY" A, AUX, DIAG, B; "BEGIN" "ARRAY" AID[1:M]; "INTEGER" "ARRAY" CI[1:M]; "PROCEDURE" LSQORTDEC(A, N, M, AUX, AID, CI);"CODE" 34134; "PROCEDURE" LSQDGLINV(A, M, AID, CI, DIAG);"CODE" 34132; "PROCEDURE" LSQSOL(A, N, M, AID, CI, B);"CODE" 34131; LSQORTDEC(A, N, M, AUX, AID, CI); "IF" AUX[3] = M "THEN" "BEGIN" LSQDGLINV(A, M, AID, CI, DIAG); LSQSOL(A, N, M, AID, CI, B) "END" "END" LSQORTDECSOL; "COMMENT" ================== 34280 =================; "PROCEDURE" SOLSVDOVR(U, VAL, V, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, X, EM; "BEGIN" "INTEGER" I; "REAL" MIN; "ARRAY" X1[1:N]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A, B; "CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A, B; "CODE" 34012; MIN:= EM[6]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" X1[I]:= "IF" VAL[I] <= MIN "THEN" 0 "ELSE" TAMVEC(1, M, I, U, X) / VAL[I]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" X[I]:= MATVEC(1, N, I, V, X1) "END" SOLSVDOVR; "COMMENT" ================== 34281 =================; "INTEGER" "PROCEDURE" SOLOVR(A, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, X, EM; "BEGIN" "INTEGER" I; "ARRAY" VAL[1:N], V[1:N,1:N]; "INTEGER" "PROCEDURE" QRISNGVALDEC(A, M, N, VAL, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, V, EM; "CODE" 34273; "PROCEDURE" SOLSVDOVR(U, VAL, V, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, X, EM; "CODE" 34280; SOLOVR:= I:= QRISNGVALDEC(A, M, N, VAL, V, EM); "IF" I = 0 "THEN" SOLSVDOVR(A, VAL, V, M, N, X, EM) "END" SOLOVR; "COMMENT" ================== 34282 =================; "PROCEDURE" SOLSVDUND(U, VAL, V, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, X, EM; "BEGIN" "INTEGER" I; "REAL" MIN; "ARRAY" X1[1:N]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A, B; "CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A, B; "CODE" 34012; MIN:= EM[6]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" X1[I]:= "IF" VAL[I] <= MIN "THEN" 0 "ELSE" TAMVEC(1, N, I, V, X) / VAL[I]; "FOR" I:= 1 "STEP" 1 "UNTIL" M "DO" X[I]:= MATVEC(1, N, I, U, X1) "END" SOLSVDUND; "COMMENT" ================== 34283 =================; "INTEGER" "PROCEDURE" SOLUND(A, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, X, EM; "BEGIN" "INTEGER" I; "ARRAY" VAL[1:N], V[1:N,1:N]; "INTEGER" "PROCEDURE" QRISNGVALDEC(A, M, N, VAL, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, V, EM; "CODE" 34273; "PROCEDURE" SOLSVDUND(U, VAL, V, M, N, X, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, X, EM; "CODE" 34282; SOLUND:= I:= QRISNGVALDEC(A, M, N, VAL, V, EM); "IF" I = 0 "THEN" SOLSVDUND(A, VAL, V, M, N, X, EM) "END" SOLUND; "COMMENT" ================== 34285 =================; "INTEGER" "PROCEDURE" HOMSOL(A, M, N, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, V, EM; "BEGIN" "INTEGER" I; "ARRAY" VAL[1:N]; "INTEGER" "PROCEDURE" QRISNGVALDEC(A, M, N, VAL, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, V, EM; "CODE" 34273; "PROCEDURE" HOMSOLSVD(U, VAL, V, M, N); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V; "CODE" 34284; HOMSOL:= I:= QRISNGVALDEC(A, M, N, VAL, V, EM); "IF" I = 0 "THEN" HOMSOLSVD(A, VAL, V, M, N) "END" HOMSOL; "COMMENT" ================== 34286 =================; "PROCEDURE" PSDINVSVD(U, VAL, V, M, N, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, EM; "BEGIN" "INTEGER" I, J; "REAL" MIN, VALI; "ARRAY" X[1:N]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A, B; "CODE" 34011; MIN:= EM[6]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "IF" VAL[I] > MIN "THEN" "BEGIN" VALI:= 1 / VAL[I]; "FOR" J:= 1 "STEP" 1 "UNTIL" M "DO" U[J,I]:= U[J,I] * VALI "END" "ELSE" "FOR" J:= 1 "STEP" 1 "UNTIL" M "DO" U[J,I]:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" X[J]:= U[I,J]; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" U[I,J]:= MATVEC(1, N, J, V, X) "END" "END" PSDINVSVD; "COMMENT" ================== 34287 =================; "INTEGER" "PROCEDURE" PSDINV(A, M, N, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, EM; "BEGIN" "INTEGER" I; "ARRAY" VAL[1:N], V[1:N,1:N]; "INTEGER" "PROCEDURE" QRISNGVALDEC(A, M, N, VAL, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, V, EM; "CODE" 34273; "PROCEDURE" PSDINVSVD(U, VAL, V, M, N, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" U, VAL, V, EM; "CODE" 34286; PSDINV:= I:= QRISNGVALDEC(A, M, N, VAL, V, EM); "IF" I = 0 "THEN" PSDINVSVD(A, VAL, V, M, N, EM) "END" PSDINV; "COMMENT" ================== 34320 =================; "PROCEDURE" DECBND(A, N, LW, RW, AUX, M, P); "VALUE" N, LW, RW; "INTEGER" N, LW, RW; "INTEGER" "ARRAY" P; "ARRAY" A, M, AUX; "BEGIN" "INTEGER" I, J, K, KK, KK1, PK, MK, IK, LW1, F, Q, W, W1, W2, NRW, IW, SDET; "REAL" R, S, EPS, MIN; "ARRAY" V[1:N]; "REAL""PROCEDURE" VECVEC(A, B, C, D, E); "CODE" 34010; "PROCEDURE" ELMVEC(A, B, C, D, E, F); "CODE" 34020; "PROCEDURE" ICHVEC(A, B, C, D); "CODE" 34030; F:= LW; W1:= LW + RW; W:= W1 + 1; W2:= W - 2; IW:= 0; SDET:= 1; NRW:= N - RW; LW1:= LW + 1; Q:= LW - 1; "FOR" I:= 2 "STEP" 1 "UNTIL" LW "DO" "BEGIN" Q:= Q - 1; IW:= IW + W1; "FOR" J:= IW - Q "STEP" 1 "UNTIL" IW "DO" A[J]:= 0 "END"; IW:= - W2; Q:= - LW; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" IW:= IW + W; "IF" I <= LW1 "THEN" IW:= IW - 1; Q:= Q + W; "IF" I > NRW "THEN" Q:= Q - 1; V[I]:= SQRT(VECVEC(IW, Q, 0, A, A)) "END"; EPS:= AUX[2]; MIN:= 1; KK:= - W1; MK:= - LW; "IF" F > NRW "THEN" W2:= W2 + NRW - F; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN""IF" F < N "THEN" F:= F + 1; IK:= KK:= KK + W; MK:= MK + LW; S:= ABS(A[KK]) / V[K]; PK:= K; KK1:= KK + 1; "FOR" I:= K + 1 "STEP" 1 "UNTIL" F "DO" "BEGIN" IK:= IK + W1; M[MK + I - K]:= R:= A[IK]; A[IK]:= 0; R:= ABS(R) / V[I]; "IF" R > S "THEN" "BEGIN" S:= R; PK:= I "END" "END"; "IF" S < MIN "THEN" MIN:= S; "IF" S < EPS "THEN" "BEGIN" AUX[3]:= K - 1; AUX[5]:= S; "GO TO" END "END"; "IF" K + W2 >= N "THEN" W2:= W2 - 1; P[K]:= PK; "IF" PK ^= K "THEN" "BEGIN" V[PK]:= V[K]; PK:= PK - K; ICHVEC(KK1, KK1 + W2, PK * W1, A); SDET:= - SDET; R:= M[MK + PK]; M[MK + PK]:= A[KK]; A[KK]:= R "END""ELSE" R:= A[KK]; "IF" R < 0 "THEN" SDET:= - SDET; IW:= KK1; LW1:= F - K + MK; "FOR" I:= MK + 1 "STEP" 1 "UNTIL" LW1 "DO" "BEGIN" M[I]:= S:= M[I] / R; IW:= IW + W1; ELMVEC(IW, IW + W2, KK1 - IW, A, A, - S) "END" "END"; AUX[3]:= N; AUX[5]:= MIN; END: AUX[1]:= SDET "END" DECBND; "COMMENT" ================== 34321 =================; "REAL""PROCEDURE" DETERMBND(A, N, LW, RW, SGNDET); "VALUE" N, LW, RW, SGNDET; "INTEGER" N, LW, RW, SGNDET; "ARRAY" A; "BEGIN""INTEGER" I, L; "REAL" P; L:= 1; P:= 1; LW:= LW + RW + 1; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" P:= A[L] * P; L:= L + LW "END"; DETERMBND:= ABS(P) * SGNDET "END" DETERMBND; "COMMENT" ================== 34071 =================; "PROCEDURE" SOLBND(A, N, LW, RW, M, P, B); "VALUE" N, LW, RW; "INTEGER" N, LW, RW; "INTEGER" "ARRAY" P; "ARRAY" A, B, M; "BEGIN" "INTEGER" F, I, K, KK, W, W1, W2, SHIFT; "REAL" S; "REAL""PROCEDURE" VECVEC(A, B, C, D, E); "CODE" 34010; "PROCEDURE" ELMVEC(A, B, C, D, E, F); "CODE" 34020; F:= LW; SHIFT:= - LW; W1:= LW - 1; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN""IF" F < N "THEN" F:= F + 1; SHIFT:= SHIFT + W1; I:=P[K]; S:= B[I]; "IF" I ^= K "THEN" "BEGIN" B[I]:= B[K]; B[K]:= S "END"; ELMVEC(K + 1, F, SHIFT, B, M, - S) "END"; W1:= LW + RW; W:= W1 + 1; KK:= (N + 1) * W - W1; W2:= - 1; SHIFT:= N * W1; "FOR" K:= N "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" KK:= KK - W; SHIFT:= SHIFT - W1; "IF" W2 < W1 "THEN" W2:= W2 + 1; B[K]:= (B[K] - VECVEC(K + 1, K + W2, SHIFT, B, A)) / A[KK] "END" "END" SOLBND; "COMMENT" ================== 34322 =================; "PROCEDURE" DECSOLBND(A, N, LW, RW, AUX, B); "VALUE" N, LW, RW; "INTEGER" N, LW, RW; "ARRAY" A, B, AUX; "BEGIN""INTEGER" I, J, K, KK, KK1, PK, IK, LW1, F, Q, W, W1, W2,IW, NRW, SHIFT, SDET; "REAL" R, S, EPS, MIN; "ARRAY" M[0:LW], V[1:N]; "REAL""PROCEDURE" VECVEC(A, B, C, D, E); "CODE" 34010; "PROCEDURE" ELMVEC(A, B, C, D, E, F); "CODE" 34020; "PROCEDURE" ICHVEC(A, B, C, D); "CODE" 34030; F:= LW; SDET:= 1; W1:= LW + RW; W:= W1 + 1; W2:= W - 2; IW:= 0; NRW:= N - RW; LW1:= LW + 1; Q:= LW - 1; "FOR" I:= 2 "STEP" 1 "UNTIL" LW "DO" "BEGIN" Q:= Q - 1; IW:= IW + W1; "FOR" J:= IW - Q "STEP" 1 "UNTIL" IW "DO" A[J]:= 0 "END"; IW:= - W2; Q:= - LW; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" IW:= IW + W; "IF" I <= LW1 "THEN" IW:= IW - 1; Q:= Q + W; "IF" I > NRW "THEN" Q:= Q - 1; V[I]:= SQRT(VECVEC(IW, Q, 0, A, A)) "END"; EPS:= AUX[2]; MIN:= 1; KK:= - W1; "IF" F > NRW "THEN" W2:= W2 + NRW - F; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN""IF" F < N "THEN" F:= F + 1; IK:= KK:= KK + W; S:= ABS(A[KK]) / V[K]; PK:= K; KK1:= KK + 1; "FOR" I:= K + 1 "STEP" 1 "UNTIL" F "DO" "BEGIN" IK:= IK + W1; M[I - K]:= R:= A[IK]; A[IK]:= 0; R:= ABS(R) / V[I]; "IF" R > S "THEN" "BEGIN" S:= R; PK:= I "END" "END"; "IF" S < MIN "THEN" MIN:= S; "IF" S < EPS "THEN" "BEGIN" AUX[3]:= K - 1; AUX[5]:= S; "GO TO" END "END"; "IF" K + W2 >= N "THEN" W2:= W2 - 1; "IF" PK ^= K "THEN" "BEGIN" V[PK]:= V[K]; PK:= PK - K; ICHVEC(KK1, KK1 + W2, PK * W1, A); SDET:= - SDET; R:= B[K]; B[K]:= B[PK + K]; B[PK + K]:= R; R:= M[PK]; M[PK]:= A[KK]; A[KK]:= R "END" "ELSE" R:= A[KK]; IW:= KK1; LW1:= F - K; "IF" R < 0 "THEN" SDET:= - SDET; "FOR" I:= 1 "STEP" 1 "UNTIL" LW1 "DO" "BEGIN" M[I]:= S:= M[I] / R; IW:= IW + W1; ELMVEC(IW, IW + W2, KK1 - IW, A, A, - S); B[K + I]:= B[K + I] - B[K] * S "END" "END"; AUX[3]:= N; AUX[5]:= MIN; KK:= (N + 1) * W - W1; W2:= - 1; SHIFT:= N * W1; "FOR" K:= N "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" KK:= KK - W; SHIFT:= SHIFT - W1; "IF" W2 < W1 "THEN" W2:= W2 + 1; B[K]:= (B[K] - VECVEC(K + 1, K + W2, SHIFT, B, A)) / A[KK] "END"; END: AUX[1]:= SDET "END" DECSOLBND; "COMMENT" ================== 34423 =================; "PROCEDURE" DECTRI(SUB, DIAG, SUPER, N, AUX); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, AUX; "BEGIN" "INTEGER" I, N1; "REAL" D, R, S, U, NORM, NORM1, TOL; TOL:= AUX[2]; D:= DIAG[1]; R:= SUPER[1]; NORM:= NORM1:= ABS(D) + ABS(R); "IF" ABS(D) <= NORM1 * TOL "THEN" "BEGIN" AUX[3]:= 0; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[1]:= R / D; S:= SUB[1]; N1:= N - 1; "FOR" I:= 2 "STEP" 1 "UNTIL" N1 "DO" "BEGIN" D:= DIAG[I]; R:= SUPER[I]; NORM1:= ABS(S) + ABS(D) + ABS(R); D:= DIAG[I]:= D - U * S; "IF" ABS(D) <= NORM1 * TOL "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[I]:= R / D; S:= SUB[I]; "IF" NORM1 > NORM "THEN" NORM:= NORM1 "END"; D:= DIAG[N]; NORM1:= ABS(D) + ABS(S); D:= DIAG[N]:= D - U * S; "IF" ABS(D) <= NORM1 * TOL "THEN" "BEGIN" AUX[3]:= N1; AUX[5]:= D; "GOTO" EXIT "END"; "IF" NORM1 > NORM "THEN" NORM:= NORM1; AUX[3]:= N; AUX[5]:= NORM; EXIT: "END" DECTRI; "COMMENT" ================== 34426 =================; "PROCEDURE" DECTRIPIV(SUB, DIAG, SUPER, N, AID, AUX, PIV); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, AID, AUX; "BOOLEAN" "ARRAY" PIV; "BEGIN" "INTEGER" I, I1, N1, N2; "REAL" D, R, S, U, T, Q, V, W, NORM, NORM1, NORM2, TOL; TOL:= AUX[2]; D:= DIAG[1]; R:= SUPER[1]; NORM:= NORM2:= ABS(D) + ABS(R); N2:= N - 2; "FOR" I:= 1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" I1:= I + 1; S:= SUB[I]; T:= DIAG[I1]; Q:= SUPER[I1]; NORM1:= NORM2; NORM2:= ABS(S) + ABS(T) + ABS(Q); "IF" NORM2 > NORM "THEN" NORM:= NORM2; "IF" ABS(D) * NORM2 < ABS(S) * NORM1 "THEN" "BEGIN" "IF" ABS(S) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= S; "GOTO" EXIT "END"; DIAG[I]:= S; U:= SUPER[I]:= T / S; V:= AID[I]:= Q / S; SUB[I]:= D; W:= SUPER[I1]:= -V * D; D:= DIAG[I1]:= R - U * D; R:= W; NORM2:= NORM1; PIV[I]:= "TRUE" "END" "ELSE" "BEGIN" "IF" ABS(D) <= TOL * NORM1 "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[I]:= R / D; D:= DIAG[I1]:= T - U * S; AID[I]:= 0; PIV[I]:= "FALSE"; R:= Q "END" "END"; N1:= N - 1; S:= SUB[N1]; T:= DIAG[N]; NORM1:= NORM2; NORM2:= ABS(S) + ABS(T); "IF" NORM2 > NORM "THEN" NORM:= NORM2; "IF" ABS(D) * NORM2 < ABS(S) * NORM1 "THEN" "BEGIN" "IF" ABS(S) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= N2; AUX[5]:= S; "GOTO" EXIT "END"; DIAG[N1]:= S; U:= SUPER[N1]:= T / S; SUB[N1]:= D; D:= DIAG[N]:= R - U * D; NORM2:= NORM1; PIV[N1]:= "TRUE" "END" "ELSE" "BEGIN" "IF" ABS(D) <= TOL * NORM1 "THEN" "BEGIN" AUX[3]:= N2; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[N1]:= R / D; D:= DIAG[N]:= T - U * S; PIV[N1]:= "FALSE" "END"; "IF" ABS(D) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= N1; AUX[5]:= D; "GOTO" EXIT "END"; AUX[3]:= N; AUX[5]:= NORM; EXIT: "END" DECTRIPIV; "COMMENT" ================== 34424 =================; "PROCEDURE" SOLTRI(SUB, DIAG, SUPER, N, B); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, B; "BEGIN" "INTEGER" I; "REAL" R; R:= B[1]:= B[1] / DIAG[1]; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" R:= B[I]:= (B[I] - SUB[I - 1] * R) / DIAG[I]; "FOR" I:= N - 1 "STEP" -1 "UNTIL" 1 "DO" R:= B[I] := B[I] - SUPER[I] * R "END" SOLTRI; "COMMENT" ================== 34425 =================; "PROCEDURE" DECSOLTRI(SUB, DIAG, SUPER, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, AUX, B; "BEGIN" "PROCEDURE" DECTRI(SUB, DIAG, SUPER, N, AUX); "CODE" 34423; "PROCEDURE" SOLTRI( SUB, DIAG, SUPER, N, B); "CODE" 34424; DECTRI(SUB, DIAG, SUPER, N, AUX); "IF" AUX[3]= N "THEN" SOLTRI(SUB, DIAG, SUPER, N, B) "END" DECSOLTRI; "COMMENT" ================== 34427 =================; "PROCEDURE" SOLTRIPIV(SUB, DIAG, SUPER, N, AID, PIV, B); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, AID, B; "BOOLEAN" "ARRAY" PIV; "BEGIN" "INTEGER" I, N1; "REAL" BI, BI1, R, S, T; N1:= N - 1; "FOR" I:= 1 "STEP" 1 "UNTIL" N1 "DO" "BEGIN" "IF" PIV[I] "THEN" "BEGIN" BI:= B[I+1]; BI1:= B[I] "END" "ELSE" "BEGIN" BI:= B[I]; BI1:= B[I+1] "END"; R:= B[I]:= BI / DIAG[I]; B[I+1]:= BI1 - SUB[I] * R "END"; R:= B[N]:= B[N] / DIAG[N]; T:= B[N1]:= B[N1] - SUPER[N1] * R; "FOR" I:= N - 2 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" S:= R; R:= T; T:= B[I]:= B[I] - SUPER[I] * R - ("IF" PIV[I] "THEN" AID[I] * S "ELSE" 0) "END" "END" SOLTRIPIV; "COMMENT" ================== 34428 =================; "PROCEDURE" DECSOLTRIPIV(SUB, DIAG, SUPER, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" SUB, DIAG, SUPER, AUX, B; "BEGIN" "INTEGER" I, I1, N1, N2; "REAL" D, R, S, U, T, Q, V, W, NORM, NORM1, NORM2, TOL, BI, BI1, BI2; "BOOLEAN" "ARRAY" PIV[1:N]; TOL:= AUX[2]; D:= DIAG[1]; R:= SUPER[1]; BI:= B[1]; NORM:= NORM2:= ABS(D) + ABS(R); N2:= N - 2; "FOR" I:= 1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" I1:= I + 1; S:= SUB[I]; T:= DIAG[I1]; Q:= SUPER[I1]; BI1:= B[I1]; NORM1:= NORM2; NORM2:= ABS(S) + ABS(T) + ABS(Q); "IF" NORM2 > NORM "THEN" NORM:= NORM2; "IF" ABS(D) * NORM2 < ABS(S) * NORM1 "THEN" "BEGIN" "IF" ABS(S) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= S; "GOTO" EXIT "END"; U:= SUPER[I]:= T / S; BI1:= B[I]:= BI1 / S; BI:= BI - BI1 * D; V:= SUB[I]:= Q / S; W:= SUPER[I1]:= -V * D; D:= DIAG[I1]:= R - U * D; R:= W; NORM2:= NORM1; PIV[I]:= "TRUE" "END" "ELSE" "BEGIN" "IF" ABS(D) <= TOL * NORM1 "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[I]:= R / D; BI:= B[I]:= BI / D; BI:= BI1 - BI * S; D:= DIAG[I1]:= T - U * S; PIV[I]:= "FALSE"; R:= Q "END" "END"; N1:= N - 1; S:= SUB[N1]; T:= DIAG[N]; NORM1:= NORM2; BI1:= B[N]; NORM2:= ABS(S) + ABS(T); "IF" NORM2 > NORM "THEN" NORM:= NORM2; "IF" ABS(D) * NORM2 < ABS(S) * NORM1 "THEN" "BEGIN" "IF" ABS(S) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= N2; AUX[5]:= S; "GOTO" EXIT "END"; U:= SUPER[N1]:= T / S; BI1:= B[N1]:= BI1 / S; BI:= BI - BI1 * D; D:= R - U * D; NORM2:= NORM1 "END" "ELSE" "BEGIN" "IF" ABS(D) <= TOL * NORM1 "THEN" "BEGIN" AUX[3]:= N2; AUX[5]:= D; "GOTO" EXIT "END"; U:= SUPER[N1]:= R / D; BI:= B[N1]:= BI / D; BI:= BI1 - BI * S; D:= T - U * S "END"; "IF" ABS(D) <= TOL * NORM2 "THEN" "BEGIN" AUX[3]:= N1; AUX[5]:= D; "GOTO" EXIT "END"; AUX[3]:= N; AUX[5]:= NORM; BI1:= B[N]:= BI / D; BI:= B[N1]:= B[N1] - SUPER[N1] * BI1; "FOR" I:= N - 2 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" BI2:= BI1; BI1:= BI; BI:= B[I]:= B[I] - SUPER[I] * BI1 - ("IF" PIV[I] "THEN" SUB[I] * BI2 "ELSE" 0) "END"; EXIT: "END" DECSOLTRIPIV; "COMMENT" ================== 34330 =================; "PROCEDURE" CHLDECBND(A, N, W, AUX); "VALUE" N, W; "INTEGER" N, W; "ARRAY" A, AUX; "BEGIN" "INTEGER" J, K, JMAX, KK, KJ, W1, START; "REAL" R, EPS, MAX; "REAL""PROCEDURE" VECVEC(L, U, S, A, B); "CODE" 34010; MAX:= 0; KK:= - W; W1:= W + 1; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" KK:= KK + W1; "IF" A[KK] > MAX "THEN" MAX:= A[KK]"END"; JMAX:= W; W1:= W + 1; KK:= - W; EPS:= AUX[2] * MAX; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN""IF" K + W > N "THEN" JMAX:= JMAX - 1; KK:= KK + W1; START:= KK - K + 1; R:= A[KK] - VECVEC("IF" K <= W1 "THEN" START "ELSE" KK - W, KK - 1, 0, A, A); "IF" R <= EPS "THEN" "BEGIN" AUX[3]:= K - 1; "GO TO" END "END"; A[KK]:= R:= SQRT(R); KJ:= KK; "FOR" J:= 1 "STEP" 1 "UNTIL" JMAX "DO" "BEGIN" KJ:= KJ + W; A[KJ]:= (A[KJ] - VECVEC("IF" K + J <= W1 "THEN" START "ELSE" KK - W + J, KK - 1, KJ - KK, A, A)) / R "END" "END"; AUX[3]:= N; END: "END" CHLDECBND; "COMMENT" ================== 34331 =================; "REAL""PROCEDURE" CHLDETERMBND(A, N, W); "VALUE" N, W; "INTEGER" N,W; "ARRAY" A; "BEGIN""INTEGER" J, KK, W1; "REAL" P; W1:= W + 1; KK:= - W; P:= 1; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" KK:= KK + W1; P:= A[KK] * P "END"; CHLDETERMBND:= P * P "END" CHLDETERMBND; "COMMENT" ================== 34332 =================; "PROCEDURE" CHLSOLBND(A, N, W, B); "VALUE" N, W; "INTEGER" N, W; "ARRAY" A, B; "BEGIN" "INTEGER" I, K, IMAX, KK, W1; "REAL""PROCEDURE" VECVEC(L, U, S, A, B); "CODE" 34010; "REAL""PROCEDURE" SCAPRD1(LA, SA, LB, SB, N, A, B); "CODE" 34017; KK:= - W; W1:= W + 1; "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" KK:= KK + W1; B[K]:= (B[K] - VECVEC("IF" K <= W1 "THEN" 1 "ELSE" K - W, K - 1, KK - K, B, A)) / A[KK] "END"; IMAX:= - 1; "FOR" K:= N "STEP" - 1 "UNTIL" 1 "DO" "BEGIN""IF" IMAX < W "THEN" IMAX:= IMAX + 1; B[K]:= (B[K] - SCAPRD1(KK + W, W, K + 1, 1, IMAX, A, B)) / A[KK]; KK:= KK - W1 "END" "END" CHLSOLBND; "COMMENT" ================== 34333 =================; "PROCEDURE" CHLDECSOLBND(A, N, W, AUX, B); "VALUE" N, W; "INTEGER" N, W; "ARRAY" A, AUX, B; "BEGIN""PROCEDURE" CHLDECBND(A, N, W, AUX); "CODE" 34330; "PROCEDURE" CHLSOLBND(A, N, W, B); "CODE" 34332; CHLDECBND(A, N, W, AUX); "IF" AUX[3] = N "THEN" CHLSOLBND(A, N, W, B) "END" CHLDECSOLBND; "COMMENT" ================== 34420 =================; "PROCEDURE" DECSYMTRI(DIAG, CO, N, AUX); "VALUE" N; "INTEGER" N; "ARRAY" DIAG, CO, AUX; "BEGIN" "INTEGER" I, N1; "REAL" D, R, S, U, TOL, NORM, NORMR; TOL:= AUX[2]; D:= DIAG[1]; R:= CO[1]; NORM:= NORMR:= ABS(D) + ABS(R); "IF" ABS(D) <= NORMR * TOL "THEN" "BEGIN" AUX[3]:= 0; AUX[5]:= D; "GOTO" EXIT "END"; U:= CO[1]:= R / D; N1:= N - 1; "FOR" I:= 2 "STEP" 1 "UNTIL" N1 "DO" "BEGIN" S:= R; R:= CO[I]; D:= DIAG[I]; NORMR:= ABS(S) + ABS(D) + ABS(R); D:= DIAG[I]:= D - U * S; "IF" ABS(D) <= NORMR * TOL "THEN" "BEGIN" AUX[3]:= I - 1; AUX[5]:= D; "GOTO" EXIT "END"; U:= CO[I]:= R / D; "IF" NORMR > NORM "THEN" NORM:= NORMR "END"; D:= DIAG[N]; NORMR:= ABS(D) + ABS(R); D:= DIAG[N]:= D - U * R; "IF" ABS(D) <= NORMR * TOL "THEN" "BEGIN" AUX[3]:= N1; AUX[5]:= D; "GOTO" EXIT "END"; "IF" NORMR > NORM "THEN" NORM:= NORMR; AUX[3]:= N; AUX[5]:= NORM; EXIT: "END" DECSYMTRI; "COMMENT" ================== 34421 =================; "PROCEDURE" SOLSYMTRI(DIAG, CO, N, B); "VALUE" N; "INTEGER" N; "ARRAY" DIAG, CO, B; "BEGIN" "INTEGER" I; "REAL" R, S; R:= B[1]; B[1]:= R / DIAG[1]; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" R:= B[I] - CO[I-1] * R; B[I]:= R / DIAG[I] "END"; S:= B[N]; "FOR" I:= N - 1 "STEP" -1 "UNTIL" 1 "DO" S:= B[I]:= B[I] - CO[I] * S "END" SOLSYMTRI; "COMMENT" ================== 34422 =================; "PROCEDURE" DECSOLSYMTRI(DIAG, CO, N, AUX, B); "VALUE" N; "INTEGER" N; "ARRAY" DIAG, CO, AUX, B; "BEGIN" "PROCEDURE" DECSYMTRI(DIAG, CO, N, AUX); "CODE" 34420; "PROCEDURE" SOLSYMTRI(DIAG, CO, N, B); "CODE" 34421; DECSYMTRI(DIAG, CO, N, AUX); "IF" AUX[3] = N "THEN" SOLSYMTRI(DIAG, CO, N, B) "END" DECSOLSYMTRI; "COMMENT" ================== 34220 =================; "PROCEDURE" CONJ GRAD( MATVEC, X, R, L, N, GO ON, ITERATE, NORM2); "VALUE" L, N; "PROCEDURE" MATVEC; "ARRAY" X, R; "BOOLEAN" GO ON; "INTEGER" L, N, ITERATE; "REAL" NORM2; "BEGIN" "ARRAY" P, AP[ L: N]; "INTEGER" I; "REAL" A, B, PRR, RRP; "REAL" "PROCEDURE" VECVEC( A, B, C, D, E); "CODE" 34010; "PROCEDURE" ELMVEC( A, B, C, D, E, F); "CODE" 34020; "FOR" ITERATE:= 0, ITERATE + 1 "WHILE" GO ON "DO" "BEGIN" "IF" ITERATE = 0 "THEN" "BEGIN" MATVEC( X, P); "FOR" I:= L "STEP" 1 "UNTIL" N "DO" P[ I]:= R[ I]:= R[ I] - P[ I]; PRR:= VECVEC( L, N, 0, R, R) "END" "ELSE" "BEGIN" B:= RRP / PRR; PRR:= RRP; "FOR" I:= L "STEP" 1 "UNTIL" N "DO" P[ I]:= R[ I] + B * P[ I] "END"; MATVEC( P, AP); A:= PRR / VECVEC( L, N, 0, P, AP); ELMVEC( L, N, 0, X, P, A); ELMVEC( L, N, 0, R, AP, -A); NORM2:= RRP:= VECVEC( L, N, 0, R, R) "END" "END" CONJ GRAD; "COMMENT" ================== 34173 =================; "COMMENT" MCA 2405; "PROCEDURE" EQILBR(A, N, EM, D, INT); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, D; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, IM, I1, P, Q, J, T, COUNT, EXPONENT, NI; "REAL" C, R, EPS, OMEGA, FACTOR; "PROCEDURE" MOVE(K); "VALUE" K; "INTEGER" K; "BEGIN" "REAL" DI; NI:= Q - P; T:= T + 1; "IF" K ^= I "THEN" "BEGIN" ICHCOL(1, N, K, I, A); ICHROW(1, N, K, I, A); DI:= D[I]; D[I]:= D[K]; D[K]:= DI "END" "END" MOVE; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "REAL" "PROCEDURE" MATTAM(L, U, I, J, A, B); "CODE" 34015; "PROCEDURE" ICHCOL(L, U, I, J, A); "CODE" 34031; "PROCEDURE" ICHROW(L, U, I, J, A); "CODE" 34032; FACTOR:= 1 / (2 * LN(2)); "COMMENT" MORE GENERALLY: LN(BASE); EPS:= EM[0]; OMEGA:= 1 / EPS; T:= P:= 1; Q:= NI:= I:= N; COUNT:= (N + 1) * N // 2; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[J]:= 1; INT[J]:= 0 "END"; "FOR" I:= "IF" I < Q "THEN" I + 1 "ELSE" P "WHILE" COUNT > 0 "AND" NI > 0 "DO" "BEGIN" COUNT:= COUNT - 1; IM:= I - 1; I1:= I + 1; C:= SQRT(TAMMAT(P, IM, I, I, A, A) + TAMMAT(I1, Q, I, I, A, A)); R:= SQRT(MATTAM(P, IM, I, I, A, A) + MATTAM(I1, Q, I, I, A, A)); "IF" C * OMEGA <= R * EPS "THEN" "BEGIN" INT[T]:= I; MOVE(P); P:= P + 1 "END" "ELSE" "IF" R * OMEGA <= C * EPS "THEN" "BEGIN" INT[T]:= -I; MOVE(Q); Q:= Q - 1 "END" "ELSE" "BEGIN" EXPONENT:= LN(R / C) * FACTOR; "IF" ABS(EXPONENT) > 1 "THEN" "BEGIN" NI:= Q - P; C:= 2 ** EXPONENT; R:= 1 / C; D[I]:= D[I] * C; "FOR" J:= 1 "STEP" 1 "UNTIL" IM, I1 "STEP" 1 "UNTIL" N "DO" "BEGIN" A[J,I]:= A[J,I] * C; A[I,J]:= A[I,J] * R "END" "END" "ELSE" NI:= NI - 1 "END" "END" "END" EQILBR; "COMMENT" ================== 34174 =================; "COMMENT" MCA 2406; "PROCEDURE" BAKLBR(N, N1, N2, D, INT, VEC); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" D, VEC; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, J, K, P, Q; "REAL" DI; "PROCEDURE" ICHROW(L, U, I, J, A); "CODE" 34032; P:= 1; Q:= N; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DI:= D[I]; "IF" DI ^= 1 "THEN" "FOR" J:= N1 "STEP" 1 "UNTIL" N2 "DO" VEC[I,J]:= VEC[I,J] * DI; K:= INT[I]; "IF" K > 0 "THEN" P:= P + 1 "ELSE" "IF" K < 0 "THEN" Q:= Q - 1 "END"; "FOR" I:= P - 1 + N - Q "STEP" -1 "UNTIL" 1 "DO" "BEGIN" K:= INT[I]; "IF" K > 0 "THEN" "BEGIN" P:= P - 1; "IF" K ^= P "THEN" ICHROW(N1, N2, K, P, VEC) "END" "ELSE" "BEGIN" Q:= Q + 1; "IF" -K ^= Q "THEN" ICHROW(N1, N2, -K, Q, VEC) "END" "END" "END" BAKLBR; "COMMENT" ================== 34361 =================; "PROCEDURE" EQILBRCOM(A1, A2, N, EM, D, INT); "VALUE" N; "INTEGER" N; "ARRAY" A1, A2, EM, D; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, P, Q, J, T, COUNT, EXPONENT, NI, IM, I1; "REAL" C, R, EPS; "PROCEDURE" ICHCOL(L,U,I,J,A);"CODE" 34031; "PROCEDURE" ICHROW(L,U,I,J,A);"CODE" 34032; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "REAL" "PROCEDURE" MATTAM(L,U,I,J,A,B);"CODE" 34015; "PROCEDURE" MOVE(K); "VALUE" K; "INTEGER" K; "BEGIN" "REAL" DI; NI:= Q - P; T:= T + 1; "IF" K ^= I "THEN" "BEGIN" ICHCOL(1, N, K, I, A1); ICHROW(1, N, K, I, A1); ICHCOL(1, N, K, I, A2); ICHROW(1, N, K, I, A2); DI:= D[I]; D[I]:= D[K]; D[K]:= DI "END" "END" MOVE; EPS:= EM[0] ** 4; T:= P:= 1; Q:= NI:= I:= N; COUNT:= EM[6]; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[J]:= 1; INT[J]:= 0 "END"; "FOR" I:= "IF" I < Q "THEN" I + 1 "ELSE" P "WHILE" COUNT > 0 "AND" NI > 0 "DO" "BEGIN" COUNT:= COUNT - 1; IM:= I - 1; I1:= I + 1; C:= TAMMAT(P, IM, I, I, A1, A1) + TAMMAT(I1, Q, I, I, A1, A1) + TAMMAT(P, IM, I, I, A2, A2) + TAMMAT(I1, Q, I, I, A2, A2); R:= MATTAM(P, IM, I, I, A1, A1) + MATTAM(I1, Q, I, I, A1, A1) + MATTAM(P, IM, I, I, A2, A2) + MATTAM(I1, Q, I, I, A2, A2); "IF" C / EPS <= R "THEN" "BEGIN" INT[T]:= I; MOVE(P); P:= P + 1 "END" "ELSE" "IF" R / EPS <= C "THEN" "BEGIN" INT[T]:= - I; MOVE(Q); Q:= Q - 1 "END" "ELSE" "BEGIN" EXPONENT:= LN(R / C) * 0.36067; "IF" ABS(EXPONENT) > 1 "THEN" "BEGIN" NI:= Q - P; C:= 2 ** EXPONENT; D[I]:= D[I] * C; "FOR" J:= 1 "STEP" 1 "UNTIL" IM, I1 "STEP" 1 "UNTIL" N "DO" "BEGIN" A1[J,I]:= A1[J,I] * C; A1[I,J]:= A1[I,J] / C; A2[J,I]:= A2[J,I] * C; A2[I,J]:= A2[I,J] / C "END" "END" "ELSE" NI:= NI - 1 "END" "END"; EM[7]:= EM[6] - COUNT "END" EQILBRCOM; "COMMENT" ================== 34362 =================; "PROCEDURE" BAKLBRCOM(N, N1, N2, D, INT, VR, VI); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" D, VR, VI; "INTEGER" "ARRAY" INT; "BEGIN" "PROCEDURE" BAKLBR(N,N1,N2,D,INT,VEC);"CODE" 34174; BAKLBR(N, N1, N2, D, INT, VR); BAKLBR(N, N1, N2, D, INT, VI) "END" BAKLBRCOM; "COMMENT" ================== 34140 =================; "COMMENT" MCA 2300; "PROCEDURE" TFMSYMTRI2(A, N, D, B, BB, EM); "VALUE" N;"INTEGER" N; "ARRAY" A, B, BB, D, EM; "BEGIN" "INTEGER" I, J, R, R1; "REAL" W, X, A1, B0, BB0, D0, MACHTOL, NORM; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013; "PROCEDURE" ELMVECCOL(L, U, I, A, B, X); "CODE" 34021; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "CODE" 34023; "PROCEDURE" ELMCOLVEC(L, U, I, A, B, X); "CODE" 34022; NORM:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" J "DO" W:= ABS(A[I,J]) + W; "FOR" I:= J + 1 "STEP" 1 "UNTIL" N "DO" W:= ABS(A[J,I]) + W; "IF" W > NORM "THEN" NORM:= W "END"; MACHTOL:= EM[0] * NORM; EM[1]:= NORM; R:= N; "FOR" R1:= N - 1 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" D[R]:= A[R,R]; X:= TAMMAT(1, R - 2, R, R, A, A); A1:= A[R1,R]; "IF" SQRT(X) <= MACHTOL "THEN" "BEGIN" B0:= B[R1]:= A1; BB[R1]:= B0 * B0;A[R,R]:= 1 "END" "ELSE" "BEGIN" BB0:= BB[R1]:= A1 * A1 + X; B0:= "IF" A1 > 0 "THEN" -SQRT(BB0) "ELSE" SQRT(BB0); A1:= A[R1,R]:= A1 - B0; W:= A[R,R]:= 1 / (A1 * B0); "FOR" J:= 1 "STEP" 1 "UNTIL" R1 "DO" B[J]:= (TAMMAT(1, J, J, R, A, A) + MATMAT(J + 1, R1, J, R, A, A)) * W; ELMVECCOL(1, R1, R, B, A, TAMVEC(1, R1, R, A, B) * W * .5); "FOR" J:= 1 "STEP" 1 "UNTIL" R1 "DO" "BEGIN" ELMCOL(1, J, J, R, A, A, B[J]); ELMCOLVEC(1, J, J, A, B, A[J,R]) "END"; B[R1]:= B0 "END"; R:= R1 "END"; D[1]:= A[1,1]; A[1,1]:= 1; B[N]:= BB[N]:= 0 "END" TFMSYMTRI2; "COMMENT" ================== 34141 =================; "COMMENT" MCA 2301; "PROCEDURE" BAKSYMTRI2(A, N, N1, N2, VEC); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" A, VEC; "BEGIN" "INTEGER" I, J, K; "REAL" W; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "CODE" 34023; "FOR" J:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= A[J,J]; "IF" W < 0 "THEN" "FOR" K:= N1 "STEP" 1 "UNTIL" N2 "DO" ELMCOL(1, J - 1, K, J, VEC, A, TAMMAT(1, J - 1, J, K, A, VEC) * W) "END" "END" BAKSYMTRI2; "COMMENT" ================== 34142 =================; "COMMENT" MCA 2302; "PROCEDURE" TFMPREVEC(A, N); "VALUE" N; "INTEGER" N; "ARRAY" A; "BEGIN" "INTEGER" I, J, J1, K; "REAL" AB; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "CODE" 34023; J1:= 1; "FOR" J:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" J1 - 1 , J "STEP" 1 "UNTIL" N "DO" A[I,J1]:= 0; A[J1,J1]:= 1; AB:= A[J,J]; "IF" AB < 0 "THEN" "FOR" K:= 1 "STEP" 1 "UNTIL" J1 "DO" ELMCOL(1, J1, K, J, A, A, TAMMAT(1, J1, J, K, A, A) * AB); J1:= J "END"; "FOR" I:= N - 1 "STEP" -1 "UNTIL" 1 "DO" A[I,N]:= 0; A[N,N]:= 1 "END" TFMPREVEC; "COMMENT" ================== 34143 =================; "COMMENT" MCA 2305; "PROCEDURE" TFMSYMTRI1(A, N, D, B, BB, EM); "VALUE" N;"INTEGER" N; "ARRAY" A, B, BB, D, EM; "BEGIN" "INTEGER" I, J, R, R1, P, Q, TI, TJ; "REAL" S, W, X, A1, B0, BB0, D0, NORM, MACHTOL; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "REAL" "PROCEDURE" SEQVEC(L, U, IL, SHIFT, A, B);"CODE" 34016; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; NORM:= 0; TJ:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" J "DO" W:= ABS(A[I + TJ]) +W; TJ:= TJ + J; TI:= TJ + J; "FOR" I:= J + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= ABS(A[TI]) + W; TI:= TI + I "END"; "IF" W > NORM "THEN" NORM:= W "END"; MACHTOL:= EM[0] * NORM; EM[1]:= NORM; Q:= (N + 1) * N // 2; R:= N; "FOR" R1:= N - 1 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" P:= Q - R; D[R]:= A[Q]; X:= VECVEC(P + 1, Q - 2, 0, A, A); A1:= A[Q - 1]; "IF" SQRT(X) <= MACHTOL "THEN" "BEGIN" B0:= B[R1]:= A1; BB[R1]:= B0 * B0; A[Q]:= 1 "END" "ELSE" "BEGIN" BB0:= BB[R1]:= A1 * A1 + X; B0:= "IF" A1 > 0 "THEN" -SQRT(BB0) "ELSE" SQRT(BB0); A1:= A[Q - 1]:= A1 - B0; W:= A[Q]:= 1 / (A1 * B0); TJ:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" R1 "DO" "BEGIN" TI:= TJ + J; S:= VECVEC(TJ + 1, TI, P - TJ, A, A); TJ:= TI + J; B[J]:= (SEQVEC(J + 1, R1, TJ, P, A, A) + S) * W; TJ:= TI "END"; ELMVEC(1, R1, P, B, A, VECVEC(1,R1,P,B,A)* W *.5); TJ:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" R1 "DO" "BEGIN" TI:= TJ + J; ELMVEC(TJ + 1, TI, P - TJ, A, A, B[J]);ELMVEC(TJ + 1, TI, -TJ, A, B, A[J + P]); TJ:= TI "END"; B[R1]:= B0 "END"; Q:= P; R:= R1 "END"; D[1]:= A[1]; A[1]:= 1; B[N]:= BB[N]:= 0 "END" TFMSYMTRI1; "COMMENT" ================== 34144 =================; "COMMENT" MCA 2306; "PROCEDURE" BAKSYMTRI1(A, N, N1, N2, VEC); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" A, VEC; "BEGIN" "INTEGER" J, J1, K, TI, TJ; "REAL" W; "ARRAY" AUXVEC[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; "FOR" K:= N1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" AUXVEC[J]:= VEC[J,K]; TJ:= J1:= 1; "FOR" J:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" TI:= TJ + J; W:= A[TI]; "IF" W < 0 "THEN" ELMVEC(1, J1, TJ, AUXVEC,A,VECVEC(1, J1, TJ, AUXVEC, A) * W); J1:= J; TJ:= TI "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" VEC[J,K]:= AUXVEC[J] "END" "END" BAKSYMTRI1; "COMMENT" ================== 34170 =================; "COMMENT" MCA 2400; "PROCEDURE" TFMREAHES(A, N, EM, INT); "VALUE" N; "INTEGER" N; "ARRAY" A, EM; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, J, J1, K, L; "REAL" S, T, MACHTOL, MACHEPS, NORM; "ARRAY" B[0:N - 1]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013; "PROCEDURE" ICHCOL(L, U, I, J, A); "CODE" 34031; "PROCEDURE" ICHROW(L, U, I, J, A); "CODE" 34032; MACHEPS:= EM[0]; NORM:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" S:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" S:= S + ABS(A[I,J]); "IF" S > NORM "THEN" NORM:= S "END"; EM[1]:= NORM; MACHTOL:= NORM * MACHEPS; INT[1]:= 0; "FOR" J:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" J1:= J - 1; L:= 0; S:= MACHTOL; "FOR" K:= J + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" T:= ABS(A[K,J1]); "IF" T > S "THEN" "BEGIN" L:= K; S:= T "END" "END"; "IF" L ^= 0 "THEN" "BEGIN" "IF" ABS(A[J,J1]) < S "THEN" "BEGIN" ICHROW(1, N, J, L, A); ICHCOL(1, N, J, L, A) "END" "ELSE" L:= J; T:= A[J,J1]; "FOR" K:= J + 1 "STEP" 1 "UNTIL" N "DO" A[K,J1]:= A[K,J1] / T "END" "ELSE" "FOR" K:= J + 1 "STEP" 1 "UNTIL" N "DO" A[K,J1]:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" B[I - 1]:= A[I,J]:= A[I,J] + ("IF" L = 0 "THEN" 0 "ELSE" MATMAT(J + 1, N, I, J1, A, A))- MATVEC(1, "IF" J1 < I - 2 "THEN" J1 "ELSE" I - 2, I, A, B); INT[J]:= L "END" "END" TFMREAHES; "COMMENT" ================== 34171 =================; "COMMENT" MCA 2401; "PROCEDURE" BAKREAHES1(A, N, INT, V); "VALUE" N; "INTEGER" N; "ARRAY" A, V; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, L; "REAL" W; "ARRAY" X[1:N]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" X[I - 1]:= V[I]; "FOR" I:= N "STEP" -1 "UNTIL" 2 "DO" "BEGIN" V[I]:= V[I] + MATVEC(1, I - 2, I, A, X); L:= INT[I]; "IF" L > I "THEN" "BEGIN" W:= V[I]; V[I]:= V[L]; V[L]:= W "END" "END" "END" BAKREAHES1; "COMMENT" ================== 34172 =================; "COMMENT" MCA 2402; "PROCEDURE" BAKREAHES2(A, N, N1, N2, INT, VEC); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" A, VEC; "INTEGER" "ARRAY" INT; "BEGIN" "INTEGER" I, L, K; "ARRAY" U[1:N]; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; "PROCEDURE" ICHROW(L, U, I, J, A); "CODE" 34032; "FOR" I:= N "STEP" -1 "UNTIL" 2 "DO" "BEGIN" "FOR" K:= I - 2 "STEP" -1 "UNTIL" 1 "DO" U[K + 1]:= A[I,K]; "FOR" K:= N1 "STEP" 1 "UNTIL" N2 "DO" VEC[I,K]:= VEC[I,K] + TAMVEC(2 , I - 1, K, VEC, U); L:= INT[I]; "IF" L > I "THEN" ICHROW(N1, N2, I, L, VEC) "END" "END" BAKREAHES2; "COMMENT" ================== 34363 =================; "PROCEDURE" HSHHRMTRI(A, N, D, B, BB, EM, TR, TI); "VALUE" N; "INTEGER" N; "ARRAY" A, D, B, BB, EM, TR, TI; "BEGIN" "INTEGER" I, J, J1, JM1, R, RM1; "REAL" NRM, W, TOL2, X, AR, AI, MOD, C, S, H, K, T, Q, AJR, ARJ, BJ, BBJ; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);"CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L,U,I,A,B);"CODE" 34012; "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);"CODE" 34013; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "REAL" "PROCEDURE" MATTAM(L,U,I,J,A,B);"CODE" 34015; "PROCEDURE" ELMVECCOL(L,U,I,A,B,X);"CODE" 34021; "PROCEDURE" ELMCOLVEC(L,U,I,A,B,X);"CODE" 34022; "PROCEDURE" ELMCOL(L,U,I,J,A,B,X);"CODE" 34023; "PROCEDURE" ELMROW(L,U,I,J,A,B,X);"CODE" 34024; "PROCEDURE" ELMVECROW(L,U,I,A,B,X);"CODE" 34026; "PROCEDURE" ELMROWVEC(L,U,I,A,B,X);"CODE" 34027; "PROCEDURE" ELMROWCOL(L,U,I,J,A,B,X);"CODE" 34028; "PROCEDURE" ELMCOLROW(L,U,I,J,A,B,X);"CODE" 34029; "PROCEDURE" CARPOL(AR,AI,R,C,S);"CODE" 34344; NRM:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= ABS(A[I,I]); "FOR" J:= I - 1 "STEP" - 1 "UNTIL" 1, I + 1 "STEP" 1 "UNTIL" N "DO" W:= W + ABS(A[I,J]) + ABS(A[J,I]); "IF" W > NRM "THEN" NRM:= W "END" I; TOL2:= (EM[0] * NRM) ** 2; EM[1]:= NRM; R:= N; "FOR" RM1:= N - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" X:= TAMMAT(1, R - 2, R, R, A, A) + MATTAM(1, R - 2, R, R, A, A); AR:= A[RM1,R]; AI:= - A[R,RM1]; D[R]:= A[R,R]; CARPOL(AR, AI, MOD, C, S); "IF" X < TOL2 "THEN" "BEGIN" A[R,R]:= - 1; B[RM1]:= MOD; BB[RM1]:= MOD * MOD "END" "ELSE" "BEGIN" H:= MOD * MOD + X; K:= SQRT(H); T:= A[R,R]:= H + MOD * K; "IF" AR = 0 "AND" AI = 0 "THEN" A[RM1,R]:= K "ELSE" "BEGIN" A[RM1,R]:= AR + C * K; A[R,RM1]:= - AI - S * K; S:= - S "END"; C:= - C; J:= 1; JM1:= 0; "FOR" J1:= 2 "STEP" 1 "UNTIL" R "DO" "BEGIN" B[J]:= (TAMMAT(1, J, J, R, A, A) + MATMAT(J1, RM1, J, R, A, A) + MATTAM(1, JM1, J, R, A, A) - MATMAT(J1, RM1, R, J, A, A)) / T; BB[J]:= (MATMAT(1, JM1, J, R, A, A) - TAMMAT(J1, RM1, J, R, A, A) - MATMAT(1, J, R, J, A, A) - MATTAM(J1, RM1, J, R, A, A)) / T; JM1:= J; J:= J1 "END" J1; Q:= (TAMVEC(1, RM1, R, A, B) - MATVEC(1, RM1, R, A, BB)) / T / 2; ELMVECCOL(1, RM1, R, B, A, - Q); ELMVECROW(1, RM1, R, BB, A, Q); J:= 1; "FOR" J1:= 2 "STEP" 1 "UNTIL" R "DO" "BEGIN" AJR:= A[J,R]; ARJ:= A[R,J]; BJ:= B[J]; BBJ:= BB[J]; ELMROWVEC(J, RM1, J, A, B, - AJR); ELMROWVEC(J, RM1, J, A, BB, ARJ); ELMROWCOL(J, RM1, J, R, A, A, - BJ); ELMROW(J, RM1, J, R, A, A, BBJ); ELMCOLVEC(J1, RM1, J, A, B, - ARJ); ELMCOLVEC(J1, RM1, J, A, BB, - AJR); ELMCOL(J1, RM1, J, R, A, A, BBJ); ELMCOLROW(J1, RM1, J, R, A, A, BJ); J:= J1; "END" J1; BB[RM1]:= H; B[RM1]:= K; "END"; TR[RM1]:= C; TI[RM1]:= S; R:= RM1; "END" RM1; D[1]:= A[1,1]; "END" HSHHRMTRI; "COMMENT" ================== 34365 =================; "PROCEDURE" BAKHRMTRI(A, N, N1, N2, VECR, VECI, TR, TI); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" A, VECR, VECI, TR, TI; "BEGIN" "INTEGER" I, J, R, RM1; "REAL" C, S, T, QR, QI; "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);"CODE" 34013; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "PROCEDURE" ELMCOL(L,U,I,J,A,B,X);"CODE" 34023; "PROCEDURE" ELMCOLROW(L,U,I,J,A,B,X);"CODE" 34029; "PROCEDURE" COMMUL(AR,AI,BR,BI,RR,RI);"CODE" 34341; "PROCEDURE" COMROWCST(L,U,I,AR,AI,XR,XI);"CODE" 34353; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= N1 "STEP" 1 "UNTIL" N2 "DO" VECI[I,J]:= 0; C:= 1; S:= 0; "FOR" J:= N - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" COMMUL(C, S, TR[J], TI[J], C, S); COMROWCST(N1, N2, J, VECR, VECI, C, S) "END" J; RM1:= 2; "FOR" R:= 3 "STEP" 1 "UNTIL" N "DO" "BEGIN" T:= A[R,R]; "IF" T > 0 "THEN" "FOR" J:= N1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" QR:= (TAMMAT(1, RM1, R, J, A, VECR) - MATMAT(1, RM1, R, J, A, VECI)) / T; QI:= (TAMMAT(1, RM1, R, J, A, VECI) + MATMAT(1, RM1, R, J, A, VECR)) / T; ELMCOL(1, RM1, J, R, VECR, A, - QR); ELMCOLROW(1, RM1, J, R, VECR, A, - QI); ELMCOLROW(1, RM1, J, R, VECI, A, QR); ELMCOL(1, RM1, J, R, VECI, A, - QI) "END"; RM1:= R; "END" R; "END" BAKHRMTRI; "COMMENT" ================== 34364 =================; "PROCEDURE" HSHHRMTRIVAL(A, N, D, BB, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, D, BB, EM; "BEGIN" "INTEGER" I, J, J1, JM1, R, RM1; "REAL" NRM, W, TOL2, X, AR, AI, H, T, Q, AJR, ARJ, DJ, BBJ, MOD2; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);"CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L,U,I,A,B);"CODE" 34012; "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);"CODE" 34013; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "REAL" "PROCEDURE" MATTAM(L,U,I,J,A,B);"CODE" 34015; "PROCEDURE" ELMVECCOL(L,U,I,A,B,X);"CODE" 34021; "PROCEDURE" ELMCOLVEC(L,U,I,A,B,X);"CODE" 34022; "PROCEDURE" ELMCOL(L,U,I,J,A,B,X);"CODE" 34023; "PROCEDURE" ELMROW(L,U,I,J,A,B,X);"CODE" 34024; "PROCEDURE" ELMVECROW(L,U,I,A,B,X);"CODE" 34026; "PROCEDURE" ELMROWVEC(L,U,I,A,B,X);"CODE" 34027; "PROCEDURE" ELMROWCOL(L,U,I,J,A,B,X);"CODE" 34028; "PROCEDURE" ELMCOLROW(L,U,I,J,A,B,X);"CODE" 34029; NRM:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= ABS(A[I,I]); "FOR" J:= I - 1 "STEP" - 1 "UNTIL" 1, I + 1 "STEP" 1 "UNTIL" N "DO" W:= W + ABS(A[I,J]) + ABS(A[J,I]); "IF" W > NRM "THEN" NRM:= W "END" I; TOL2:= (EM[0] * NRM) ** 2; EM[1]:= NRM; R:= N; "FOR" RM1:= N - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" X:= TAMMAT(1, R - 2, R, R, A, A) + MATTAM(1, R - 2, R, R, A, A); AR:= A[RM1,R]; AI:= - A[R,RM1]; D[R]:= A[R,R]; "IF" X < TOL2 "THEN" BB[RM1]:= AR * AR + AI * AI "ELSE" "BEGIN" MOD2:= AR * AR + AI * AI; "IF" MOD2 = 0 "THEN" "BEGIN" A[RM1,R]:= SQRT(X); T:= X "END" "ELSE" "BEGIN" X:= X + MOD2; H:= SQRT(MOD2 * X); T:= X + H; H:= 1 + X / H; A[R,RM1]:= - AI * H; A[RM1,R]:= AR * H; "END"; J:= 1; JM1:= 0; "FOR" J1:= 2 "STEP" 1 "UNTIL" R "DO" "BEGIN" D[J]:= (TAMMAT(1, J, J, R, A, A) + MATMAT(J1, RM1, J, R, A, A) + MATTAM(1, JM1, J, R, A, A) - MATMAT(J1, RM1, R, J, A, A)) / T; BB[J]:= (MATMAT(1, JM1, J, R, A, A) - TAMMAT(J1, RM1, J, R, A, A) - MATMAT(1, J, R, J, A, A) - MATTAM(J1, RM1, J, R, A, A)) / T; JM1:= J; J:= J1 "END" J1; Q:= (TAMVEC(1, RM1, R, A, D) - MATVEC(1, RM1, R, A, BB)) / T / 2; ELMVECCOL(1, RM1, R, D, A, - Q); ELMVECROW(1, RM1, R, BB, A, Q); J:= 1; "FOR" J1:= 2 "STEP" 1 "UNTIL" R "DO" "BEGIN" AJR:= A[J,R]; ARJ:= A[R,J]; DJ:= D[J]; BBJ:= BB[J]; ELMROWVEC(J, RM1, J, A, D, - AJR); ELMROWVEC(J, RM1, J, A, BB, ARJ); ELMROWCOL(J, RM1, J, R, A, A, - DJ); ELMROW(J, RM1, J, R, A, A, BBJ); ELMCOLVEC(J1, RM1, J, A, D, - ARJ); ELMCOLVEC(J1, RM1, J, A, BB, - AJR); ELMCOL(J1, RM1, J, R, A, A, BBJ); ELMCOLROW(J1, RM1, J, R, A, A, DJ); J:= J1; "END" J1; BB[RM1]:= X; "END"; R:= RM1; "END" RM1; D[1]:= A[1,1]; "END" HSHHRMTRIVAL; "COMMENT" ================== 34366 =================; "PROCEDURE" HSHCOMHES(AR, AI, N, EM, B, TR, TI, DEL); "VALUE" N; "INTEGER" N; "ARRAY" AR, AI, EM, B, TR, TI, DEL; "BEGIN" "INTEGER" R, RM1, I, J, NM1; "REAL" TOL, T, XR, XI; "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);"CODE" 34013; "PROCEDURE" ELMROWCOL(L,U,I,J,A,B,X);"CODE" 34028; "PROCEDURE" HSHCOMPRD(I,II,L,U,J,AR,AI,BR,BI,T);"CODE" 34356; "PROCEDURE" COMCOLCST(L,U,J,AR,AI,XR,XI);"CODE" 34352; "PROCEDURE" COMROWCST(L,U,I,AR,AI,XR,XI);"CODE" 34353; "PROCEDURE" CARPOL(AR,AI,R,C,S);"CODE" 34344; "PROCEDURE" COMMUL(AR,AI,BR,BI,RR,RI);"CODE" 34341; "BOOLEAN" "PROCEDURE" HSHCOMCOL(L,U,J,AR,AI,TOL,K,C,S,T); "CODE" 34355; NM1:= N - 1; TOL:= (EM[0] * EM[1]) ** 2; RM1:= 1; "FOR" R:= 2 "STEP" 1 "UNTIL" NM1 "DO" "BEGIN" "IF" HSHCOMCOL(R, N, RM1, AR, AI, TOL, B[RM1], TR[R], TI[R], T) "THEN" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" XR:= (MATMAT(R, N, I, RM1, AI, AI) - MATMAT(R, N, I, RM1, AR, AR)) / T; XI:= ( - MATMAT(R, N, I, RM1, AR, AI) - MATMAT(R, N, I, RM1, AI, AR)) / T; ELMROWCOL(R, N, I, RM1, AR, AR, XR); ELMROWCOL(R, N, I, RM1, AR, AI, XI); ELMROWCOL(R, N, I, RM1, AI, AR, XI); ELMROWCOL(R, N, I, RM1, AI, AI, - XR) "END"; HSHCOMPRD(R, N, R, N, RM1, AR, AI, AR, AI, T); "END"; DEL[RM1]:= T; RM1:= R "END" FORR; "IF" N > 1 "THEN" CARPOL(AR[N,NM1], AI[N,NM1], B[NM1], TR[N], TI[N]); RM1:= 1; TR[1]:= 1; TI[1]:= 0; "FOR" R:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" COMMUL(TR[RM1], TI[RM1], TR[R], TI[R], TR[R], TI[R]); COMCOLCST(1, RM1, R, AR, AI, TR[R], TI[R]); COMROWCST(R + 1, N, R, AR, AI, TR[R], - TI[R]); RM1:= R "END"; "END" HSHCOMHES; "COMMENT" ================== 34367 =================; "PROCEDURE" BAKCOMHES(AR, AI, TR, TI, DEL, VR, VI, N, N1, N2); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" AR, AI, TR, TI, DEL, VR, VI; "BEGIN" "INTEGER" I, R, RM1; "REAL" H; "PROCEDURE" HSHCOMPRD(I,II,L,U,J,AR,AI,BR,BI,T);"CODE" 34356; "PROCEDURE" COMROWCST(L,U,I,AR,AI,XR,XI);"CODE" 34353; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" COMROWCST(N1, N2, I, VR, VI, TR[I], TI[I]); R:= N - 1; "FOR" RM1:= N - 2 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" H:= DEL[RM1]; "IF" H > 0 "THEN" HSHCOMPRD(R, N, N1, N2, RM1, VR, VI, AR, AI, H); R:= RM1 "END" "END" BAKCOMHES; "COMMENT" ================== 34260 =================; "PROCEDURE" HSHREABID(A, M, N, D, B, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, D, B, EM; "BEGIN" "INTEGER" I, J, I1; "REAL" NORM, MACHTOL, W, S, F, G, H; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "VALUE" L, U, I, J; "INTEGER" L, U, I, J; "ARRAY" A, B; "CODE" 34014; "REAL" "PROCEDURE" MATTAM(L, U, I, J, A, B); "VALUE" L, U, I, J; "ARRAY" A, B; "CODE" 34015; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "VALUE" L, U, I, J, X; "INTEGER" L, U, I, J; "REAL" X; "ARRAY" A, B; "CODE" 34023; "PROCEDURE" ELMROW(L, U, I, J, A, B, X); "VALUE" L, U, I, J, X; "INTEGER" L, U, I, J; "REAL" X; "ARRAY" A, B; "CODE" 34024; NORM:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" W:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" W:= ABS(A[I,J]) + W; "IF" W > NORM "THEN" NORM:= W "END"; MACHTOL:= EM[0] * NORM; EM[1]:= NORM; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" I1:= I + 1; S:= TAMMAT(I1, M, I, I, A, A); "IF" S < MACHTOL "THEN" D[I]:= A[I,I] "ELSE" "BEGIN" F:= A[I,I]; S:= F * F + S; D[I]:= G:= "IF" F < 0 "THEN" SQRT(S) "ELSE" - SQRT(S); H:= F * G - S; A[I,I]:= F - G; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" ELMCOL(I, M, J, I, A, A, TAMMAT(I, M, I, J, A, A) / H) "END"; "IF" I < N "THEN" "BEGIN" S:= MATTAM(I1 + 1, N, I, I, A, A); "IF" S < MACHTOL "THEN" B[I]:= A[I,I1] "ELSE" "BEGIN" F:= A[I,I1]; S:= F * F + S; B[I]:= G:= "IF" F < 0 "THEN" SQRT(S) "ELSE" - SQRT(S); H:= F * G - S; A[I,I1]:= F - G; "FOR" J:= I1 "STEP" 1 "UNTIL" M "DO" ELMROW(I1, N, J, I, A, A, MATTAM(I1, N, I, J, A, A) / H) "END" "END" "END" "END" HSHREABID; "COMMENT" ================== 34261 =================; "PROCEDURE" PSTTFMMAT(A, N, V, B); "VALUE" N; "INTEGER" N; "ARRAY" A, V, B; "BEGIN" "INTEGER" I, I1, J; "REAL" H; "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "VALUE" L, U, I, J; "INTEGER" L, U, I, J; "ARRAY" A, B; "CODE" 34013; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "VALUE" L, U, I, J, X; "INTEGER" L, U, I, J; "REAL" X; "ARRAY" A, B; "CODE" 34023; I1:= N; V[N,N]:= 1; "FOR" I:= N - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" H:= B[I] * A[I,I1]; "IF" H < 0 "THEN" "BEGIN" "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" V[J,I]:= A[I,J] / H; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" ELMCOL(I1, N, J, I, V, V, MATMAT(I1, N, I, J, A, V)) "END"; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" V[I,J]:= V[J,I]:= 0; V[I,I]:= 1; I1:= I "END" "END" PSTTFMMAT; "COMMENT" ================== 34262 =================; "PROCEDURE" PRETFMMAT(A, M, N, D); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, D; "BEGIN" "INTEGER" I, I1, J; "REAL" G, H; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "VALUE" L, U, I, J; "INTEGER" L, U, I, J; "ARRAY" A, B; "CODE" 34014; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "VALUE" L, U, I, J, X; "INTEGER" L, U, I, J; "REAL" X; "ARRAY" A, B; "CODE" 34023; "FOR" I:= N "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" I1:= I + 1; G:= D[I]; H:= G * A[I,I]; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" A[I,J]:= 0; "IF" H < 0 "THEN" "BEGIN" "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" ELMCOL(I, M, J, I, A, A, TAMMAT(I1, M, I, J, A, A) / H); "FOR" J:= I "STEP" 1 "UNTIL" M "DO" A[J,I]:= A[J,I] / G "END" "ELSE" "FOR" J:= I "STEP" 1 "UNTIL" M "DO" A[J,I]:= 0; A[I,I]:= A[I,I] + 1 "END" "END" PRETFMMAT; "COMMENT" ================== 34151 =================; "COMMENT" MCA 2311; "PROCEDURE" VALSYMTRI(D, BB, N, N1, N2, VAL, EM); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" D, BB, VAL, EM; "BEGIN" "INTEGER" K, COUNT; "REAL" MAX, X, Y, MACHEPS, NORM, RE, MACHTOL, UB, LB, LAMBDA; "REAL" "PROCEDURE" STURM; "BEGIN" "INTEGER" P, I; "REAL" F; COUNT:= COUNT + 1; P:= K; F:= D[1] - X; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" F <= 0 "THEN" "BEGIN" P:= P + 1; "IF" P > N "THEN" "GOTO" OUT "END" "ELSE" "IF" P < I - 1 "THEN" "BEGIN" LB:= X; "GOTO" OUT "END"; "IF" ABS(F) < MACHTOL "THEN" F:= "IF" F <= 0 "THEN" - MACHTOL "ELSE" MACHTOL; F:= D[I] - X - BB[I - 1] / F "END"; "IF" P = N "OR" F <= 0 "THEN" "BEGIN" "IF" X < UB "THEN" UB:= X "END" "ELSE" LB:= X; OUT: STURM:= "IF" P = N "THEN" F "ELSE" (N - P) * MAX "END" STURM; "BOOLEAN" "PROCEDURE" ZEROIN(X, Y, FX, TOLX); "CODE" 34150; MACHEPS:= EM[0]; NORM:= EM[1]; RE:= EM[2]; MACHTOL:= NORM * MACHEPS; MAX:= NORM / MACHEPS; COUNT:= 0; UB:= 1.1 * NORM; LB:= - UB; LAMBDA:= UB; "FOR" K:= N1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" X:= LB; Y:= UB; LB:= -1.1 * NORM; ZEROIN(X, Y, STURM, ABS(X) * RE + MACHTOL); VAL[K]:= LAMBDA:= "IF" X > LAMBDA "THEN" LAMBDA "ELSE" X; "IF" UB > X "THEN" UB:= "IF" X > Y "THEN" X "ELSE" Y "END"; EM[3]:= COUNT "END" VALSYMTRI; "COMMENT" ================== 34152 =================; "COMMENT" MCA 2312; "PROCEDURE" VECSYMTRI(D, B, N, N1, N2, VAL, VEC, EM); "VALUE" N, N1, N2; "INTEGER" N, N1, N2; "ARRAY" D, B, VAL, VEC, EM; "BEGIN" "INTEGER" I, J, K, COUNT, MAXCOUNT, COUNTLIM, ORTH, IND; "REAL" BI, BI1, U, W, Y, MI1, LAMBDA, OLDLAMBDA, ORTHEPS, VALSPREAD, SPR, RES, MAXRES, OLDRES, NORM, NEWNORM, OLDNORM, MACHTOL, VECTOL; "ARRAY" M, P, Q, R, X[1:N]; "BOOLEAN" "ARRAY" INT[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "PROCEDURE" ELMVECCOL(L, U, I, A, B, X); "CODE" 34021; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; NORM:= EM[1]; MACHTOL:= EM[0] * NORM; VALSPREAD:= EM[4] * NORM; VECTOL:= EM[6] * NORM; COUNTLIM:= EM[8]; ORTHEPS:= SQRT(EM[0]); MAXCOUNT:= IND:= 0; MAXRES:= 0; "IF" N1 > 1 "THEN" "BEGIN" ORTH:= EM[5]; OLDLAMBDA:= VAL[N1 - ORTH]; "FOR" K:= N1 - ORTH + 1 "STEP" 1 "UNTIL" N1 - 1 "DO" "BEGIN" LAMBDA:= VAL[K]; SPR:= OLDLAMBDA - LAMBDA; "IF" SPR < MACHTOL "THEN" LAMBDA:= OLDLAMBDA - MACHTOL; OLDLAMBDA:= LAMBDA "END" "END" "ELSE" ORTH:= 1; "FOR" K:= N1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" LAMBDA:= VAL[K]; "IF" K > 1 "THEN" "BEGIN" SPR:= OLDLAMBDA - LAMBDA; "IF" SPR < VALSPREAD "THEN" "BEGIN" "IF" SPR < MACHTOL "THEN" LAMBDA:= OLDLAMBDA - MACHTOL; ORTH:= ORTH +1 "END" "ELSE" ORTH:= 1 "END"; COUNT:= 0; U:= D[1] - LAMBDA; BI:= W:= B[1]; "IF" ABS(BI) < MACHTOL "THEN" BI:= MACHTOL; "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" BI1:= B[I + 1]; "IF" ABS(BI1) < MACHTOL "THEN" BI1:= MACHTOL; "IF" ABS(BI) >= ABS(U) "THEN" "BEGIN" MI1:= M[I + 1]:= U / BI; P[I]:= BI; Y:= Q[I]:= D[I + 1] - LAMBDA; R[I]:= BI1; U:= W - MI1 * Y; W:= - MI1 * BI1; INT[I]:= "TRUE" "END" "ELSE" "BEGIN" MI1:= M[I + 1]:= BI / U; P[I]:= U; Q[I]:= W; R[I]:= 0; U:= D[I + 1] - LAMBDA - MI1 * W;W:= BI1; INT[I]:= "FALSE" "END"; X[I]:= 1; BI:= BI1 "END" TRANSFORM; P[N]:= "IF" ABS(U) < MACHTOL "THEN" MACHTOL "ELSE" U; Q[N]:= R[N]:= 0; X[N]:= 1; "GOTO" ENTRY; ITERATE: W:= X[1]; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" INT[I - 1] "THEN" "BEGIN" U:= W; W:= X[I - 1]:= X[I] "END" "ELSE" U:= X[I]; W:= X[I]:= U - M[I] * W "END" ALTERNATE; ENTRY: U:= W:= 0; "FOR" I:= N "STEP" -1 "UNTIL" 1 "DO" "BEGIN" Y:= U; U:= X[I]:= (X[I] - Q[I] * U - R[I] * W) / P[I]; W:= Y "END" NEXT ITERATION; NEWNORM:= SQRT(VECVEC(1, N, 0, X, X)); "IF" ORTH > 1"THEN" "BEGIN" OLDNORM:= NEWNORM; "FOR" J:= K - ORTH + 1 "STEP" 1 "UNTIL" K - 1 "DO" ELMVECCOL(1, N, J, X, VEC, -TAMVEC(1, N, J, VEC, X)); NEWNORM:= SQRT(VECVEC(1, N, 0, X, X)); "IF" NEWNORM < ORTHEPS * OLDNORM "THEN" "BEGIN" IND:= IND + 1; COUNT:= 1; "FOR" I:= 1 "STEP" 1 "UNTIL" IND - 1, IND + 1 "STEP" 1 "UNTIL" N "DO" X[I]:= 0; X[IND]:= 1; "IF" IND = N "THEN" IND:= 0; "GOTO" ITERATE "END" NEW START "END" ORTHOGONALISATION; RES:= 1 / NEWNORM; "IF" RES > VECTOL "OR" COUNT = 0 "THEN" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT <= COUNTLIM "THEN" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" X[I]:= X[I] * RES; "GOTO" ITERATE "END" "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" VEC[I,K]:= X[I] * RES; "IF" COUNT > MAXCOUNT "THEN" MAXCOUNT:= COUNT; "IF" RES > MAXRES "THEN" MAXRES:= RES; OLDLAMBDA:= LAMBDA "END"; EM[5]:= ORTH; EM[7]:= MAXRES; EM[9]:= MAXCOUNT "END" VECSYMTRI; "COMMENT" ================== 34161 =================; "COMMENT" MCA 2321; "INTEGER" "PROCEDURE" QRISYMTRI(A, N, D, B, BB, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, D, B, BB, EM; "BEGIN" "INTEGER" I, J, J1, K, M, M1, COUNT, MAX; "REAL" BBMAX, R, S, SIN, T, C, COS, OLDCOS, G, P, W, TOL, TOL2, LAMBDA, DK1, A0, A1; "PROCEDURE" ROTCOL(L, U, I, J, A, C, S); "CODE" 34040; TOL:= EM[2] * EM[1]; TOL2:= TOL * TOL; COUNT:= 0; BBMAX:= 0; MAX:= EM[4]; M:= N; IN: K:= M; M1:= M - 1; NEXT: K:= K - 1; "IF" K > 0 "THEN" "BEGIN" "IF" BB[K] >= TOL2 "THEN" "GOTO" NEXT; "IF" BB[K] > BBMAX "THEN" BBMAX:= BB[K] "END"; "IF" K = M1 "THEN" M:= M1 "ELSE" "BEGIN" T:= D[M] - D[M1]; R:= BB[M1]; "IF" ABS(T) < TOL "THEN" S:= SQRT(R) "ELSE" "BEGIN" W:= 2 / T; S:= W * R / (SQRT(W * W * R + 1) + 1) "END"; "IF" K = M - 2 "THEN" "BEGIN" D[M]:= D[M] + S; D[M1]:= D[M1] - S; T:= - S / B[M1]; R:= SQRT(T * T + 1); COS:= 1 / R; SIN:= T / R; ROTCOL(1,N,M1,M,A,COS,SIN); M:= M - 2 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" END; LAMBDA:= D[M] + S; "IF" ABS(T) < TOL "THEN" "BEGIN" W:= D[M1] - S; "IF" ABS(W) < ABS(LAMBDA) "THEN" LAMBDA:= W "END"; K:= K + 1; T:= D[K] - LAMBDA; COS:= 1; W:= B[K]; P:= SQRT(T * T + W * W); J1:= K; "FOR" J:= K + 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" OLDCOS:= COS; COS:= T / P; SIN:= W / P; DK1:= D[J] - LAMBDA; T:= OLDCOS * T; D[J1]:= (T + DK1) * SIN * SIN + LAMBDA + T; T:= COS * DK1 - SIN * W * OLDCOS; W:= B[J]; P:= SQRT(T * T + W * W); G:= B[J1]:= SIN * P; BB[J1]:= G * G; ROTCOL(1, N, J1, J, A, COS, SIN); J1:= J "END"; D[M]:= COS * T + LAMBDA; "IF" T < 0 "THEN" B[M1]:= - G "END" QRSTEP "END"; "IF" M > 0 "THEN" "GOTO" IN; END: EM[3]:= SQRT(BBMAX); EM[5]:= COUNT; QRISYMTRI:= M "END" QRISYMTRI; "COMMENT" ================== 34153 =================; "COMMENT" MCA 2313; "PROCEDURE" EIGVALSYM2(A, N, NUMVAL, VAL, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B, BB, D[1:N]; "PROCEDURE" TFMSYMTRI2(A, N, D, B, BB, EM); "CODE" 34140; "PROCEDURE" VALSYMTRI(D, BB, N, N1, N2, VAL, EM); "CODE" 34151; TFMSYMTRI2(A, N, D, B, BB, EM); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM) "END" EIGVALSYM2; "COMMENT" ================== 34154 =================; "COMMENT" MCA 2314; "PROCEDURE" EIGSYM2(A, N, NUMVAL, VAL, VEC, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, VEC, EM; "BEGIN" "ARRAY" B, BB, D[1:N]; "PROCEDURE" TFMSYMTRI2(A, N, D, B, BB, EM); "CODE" 34140; "PROCEDURE" VALSYMTRI(D, BB, N, N1, N2, VAL, EM); "CODE" 34151; "PROCEDURE" VECSYMTRI(D, B, N, N1, N2, VAL, VEC, EM); "CODE" 34152; "PROCEDURE" BAKSYMTRI2(A, N, N1, N2, VEC); "CODE" 34141; TFMSYMTRI2(A, N, D, B, BB, EM); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM); VECSYMTRI(D, B, N, 1, NUMVAL, VAL, VEC, EM); BAKSYMTRI2(A, N, 1, NUMVAL, VEC) "END" EIGSYM2; "COMMENT" ================== 34155 =================; "COMMENT" MCA 2318; "PROCEDURE" EIGVALSYM1(A, N, NUMVAL, VAL, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B, BB, D[1:N]; "PROCEDURE" TFMSYMTRI1(A, N, D, B, BB, EM); "CODE" 34143; "PROCEDURE" VALSYMTRI(D, BB, N, N1, N2, VAL, EM); "CODE" 34151; TFMSYMTRI1(A, N, D, B, BB, EM); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM) "END" EIGVALSYM1; "COMMENT" ================== 34156 =================; "COMMENT" MCA 2319; "PROCEDURE" EIGSYM1(A, N, NUMVAL, VAL, VEC, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, VEC, EM; "BEGIN" "ARRAY" B, BB, D[1:N]; "PROCEDURE" TFMSYMTRI1(A, N, D, B, BB, EM); "CODE" 34143; "PROCEDURE" VALSYMTRI(D, BB, N, N1, N2, VAL, EM); "CODE" 34151; "PROCEDURE" VECSYMTRI(D, B, N, N1, N2, VAL, VEC, EM); "CODE" 34152; "PROCEDURE" BAKSYMTRI1(A, N, N1, N2, VEC); "CODE" 34144; TFMSYMTRI1(A, N, D, B, BB, EM); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM); VECSYMTRI(D, B, N, 1, NUMVAL, VAL, VEC, EM); BAKSYMTRI1(A, N, 1, NUMVAL, VEC) "END" EIGSYM1; "COMMENT" ================== 34162 =================; "COMMENT" MCA 2322; "INTEGER" "PROCEDURE" QRIVALSYM2(A, N, VAL, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B, BB[1:N]; "PROCEDURE" TFMSYMTRI2(A, N, D, B, BB, EM); "CODE" 34140; "INTEGER" "PROCEDURE" QRIVALSYMTRI(D, BB, N, EM); "CODE" 34160; TFMSYMTRI2(A, N, VAL, B, BB, EM); QRIVALSYM2:= QRIVALSYMTRI(VAL, BB, N, EM) "END" QRIVALSYM2; "COMMENT" ================== 34163 =================; "COMMENT" MCA 2323; "INTEGER" "PROCEDURE" QRISYM(A, N, VAL, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B, BB[1:N]; "PROCEDURE" TFMSYMTRI2(A, N, D, B, BB, EM); "CODE" 34140; "PROCEDURE" TFMPREVEC(A, N); "CODE" 34142; "INTEGER" "PROCEDURE" QRISYMTRI(A, N, D, B, BB, EM); "CODE" 34161; TFMSYMTRI2(A, N, VAL, B, BB, EM); TFMPREVEC(A, N); QRISYM:= QRISYMTRI(A, N, VAL, B, BB, EM) "END" QRISYM; "COMMENT" ================== 34164 =================; "COMMENT" MCA 2327; "INTEGER" "PROCEDURE" QRIVALSYM1(A, N, VAL, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B, BB[1 : N]; "PROCEDURE" TFMSYMTRI1(A, N, D, B, BB, EM); "CODE" 34143; "INTEGER" "PROCEDURE" QRIVALSYMTRI(D, BB, N, EM); "CODE" 34160; TFMSYMTRI1(A, N, VAL, B, BB, EM); QRIVALSYM1:= QRIVALSYMTRI(VAL, BB, N, EM) "END" QRIVALSYM1; "COMMENT" ================== 34180 =================; "COMMENT" MCA 2410; "INTEGER" "PROCEDURE" REAVALQRI(A, N, EM, VAL); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, VAL; "BEGIN" "INTEGER" N1, I, I1, J, Q, MAX, COUNT; "REAL" DET, W, SHIFT, KAPPA, NU, MU, R, TOL, DELTA, MACHTOL, S; "PROCEDURE" ROTCOL(L, U, I, J, A, C, S); "CODE" 34040; "PROCEDURE" ROTROW(L, U, I, J, A, C, S); "CODE" 34041; MACHTOL:= EM[0] * EM[1]; TOL:= EM[1] * EM[2]; MAX:= EM[4]; COUNT:= 0; R:= 0; IN: N1:= N - 1; "FOR" I:= N, I - 1 "WHILE" ("IF" I >= 1 "THEN" ABS(A[I + 1,I]) > TOL "ELSE" "FALSE") "DO" Q:= I; "IF" Q > 1 "THEN" "BEGIN" "IF" ABS(A[Q,Q - 1]) > R "THEN" R:= ABS(A[Q,Q - 1]) "END"; "IF" Q = N "THEN" "BEGIN" VAL[N]:= A[N,N]; N:= N1 "END" "ELSE" "BEGIN" DELTA:= A[N,N] - A[N1,N1]; DET:= A[N,N1] * A[N1,N]; "IF" ABS(DELTA) < MACHTOL "THEN" S:= SQRT(DET) "ELSE" "BEGIN" W:= 2 / DELTA; S:= W * W * DET + 1; S:= "IF" S <= 0 "THEN" -DELTA * .5 "ELSE" W * DET / (SQRT(S) + 1) "END"; "IF" Q = N1 "THEN" "BEGIN" VAL[N]:= A[N,N] + S; VAL[N1]:= A[N1,N1] - S; N:= N - 2 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" OUT; SHIFT:= A[N,N] + S; "IF" ABS(DELTA) < TOL "THEN" "BEGIN" W:= A[N1,N1] - S; "IF" ABS(W) < ABS(SHIFT) "THEN" SHIFT:= W "END"; A[Q,Q]:= A[Q,Q] - SHIFT; "FOR" I:= Q "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" I1:= I + 1; A[I1,I1]:= A[I1,I1] - SHIFT; KAPPA:= SQRT(A[I,I] ** 2 + A[I1,I] ** 2); "IF" I > Q "THEN" "BEGIN" A[I,I - 1]:= KAPPA * NU; W:= KAPPA * MU "END" "ELSE" W:= KAPPA; MU:= A[I,I] / KAPPA; NU:= A[I1,I] / KAPPA; A[I,I]:= W; ROTROW(I1, N, I, I1, A, MU, NU); ROTCOL(Q, I, I, I1, A, MU, NU); A[I,I]:= A[I,I] + SHIFT "END"; A[N,N - 1]:= A[N,N] * NU; A[N,N]:= A[N,N] * MU + SHIFT "END" "END"; "IF" N > 0 "THEN" "GOTO" IN; OUT: EM[3]:= R; EM[5]:= COUNT; REAVALQRI:= N "END" REAVALQRI; "COMMENT" ================== 34181 =================; "COMMENT" MCA 2411; "PROCEDURE" REAVECHES(A, N, LAMBDA, EM, V); "VALUE" N, LAMBDA; "INTEGER" N; "REAL" LAMBDA; "ARRAY" A, EM, V; "BEGIN" "INTEGER" I, I1, J, COUNT, MAX; "REAL" M, R, NORM, MACHTOL, TOL; "BOOLEAN" "ARRAY" P[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; NORM:= EM[1]; MACHTOL:= EM[0] * NORM; TOL:= EM[6] * NORM; MAX:= EM[8]; A[1,1]:= A[1,1] - LAMBDA; GAUSS: "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" I1:= I + 1; R:= A[I,I]; M:= A[I1,I]; "IF" ABS(M) < MACHTOL "THEN" M:= MACHTOL; P[I]:= ABS(M) <= ABS(R); "IF" P[I] "THEN" "BEGIN" A[I1,I]:= M:= M / R; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" A[I1,J]:= ("IF" J > I1 "THEN" A[I1,J] "ELSE" A[I1,J] - LAMBDA) - M * A[I,J] "END" "ELSE" "BEGIN" A[I,I]:= M; A[I1,I]:= M:= R / M; "FOR" J:= I1 "STEP" 1 "UNTIL" N "DO" "BEGIN" R:= ("IF" J > I1 "THEN" A[I1,J] "ELSE" A[I1,J] - LAMBDA); A[I1,J]:= A[I,J] - M * R; A[I,J]:= R "END" "END" "END" GAUSS; "IF" ABS(A[N,N]) < MACHTOL "THEN" A[N,N]:= MACHTOL; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" V[J]:= 1; COUNT:= 0; FORWARD: COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" OUT; "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" I1:= I + 1; "IF" P[I] "THEN" V[I1]:= V[I1] - A[I1,I] * V[I] "ELSE" "BEGIN" R:= V[I1]; V[I1]:= V[I] - A[I1,I] * R; V[I]:=R "END" "END" FORWARD; BACKWARD: "FOR" I:= N "STEP" -1 "UNTIL" 1 "DO" V[I]:= (V[I] - MATVEC(I + 1, N, I, A, V)) / A[I,I]; R:= 1 / SQRT(VECVEC(1, N, 0, V, V)); "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" V[J]:= V[J] * R; "IF" R > TOL "THEN" "GOTO" FORWARD; OUT: EM[7]:= R; EM[9]:= COUNT "END" REAVECHES; "COMMENT" ================== 34186 =================; "COMMENT" MCA 2416; "INTEGER" "PROCEDURE" REAQRI(A, N, EM, VAL, VEC); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, VAL, VEC; "BEGIN" "INTEGER" M1, I, I1, M, J, Q, MAX, COUNT; "REAL" W, SHIFT, KAPPA, NU, MU, R, TOL, S, MACHTOL, ELMAX, T, DELTA, DET; "ARRAY" TF[1:N]; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "PROCEDURE" ROTCOL(L, U, I, J, A, C, S); "CODE" 34040; "PROCEDURE" ROTROW(L, U, I, J, A, C, S); "CODE" 34041; MACHTOL:= EM[0] * EM[1]; TOL:= EM[1] * EM[2]; MAX:= EM[4]; COUNT:= 0; ELMAX:= 0; M:= N; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" VEC[I,I]:= 1; "FOR" J:= I + 1 "STEP" 1 "UNTIL" N "DO" VEC[I,J]:= VEC[J,I]:= 0 "END"; IN: M1:= M - 1; "FOR" I:= M, I - 1 "WHILE" ("IF" I >= 1 "THEN" ABS(A[I + 1,I]) > TOL "ELSE" "FALSE") "DO" Q:= I; "IF" Q > 1 "THEN" "BEGIN" "IF" ABS(A[Q,Q - 1]) > ELMAX "THEN" ELMAX:= ABS(A[Q, Q - 1]) "END"; "IF" Q = M "THEN" "BEGIN" VAL[M]:= A[M,M]; M:= M1 "END" "ELSE" "BEGIN" DELTA:= A[M,M] - A[M1,M1]; DET:= A[M,M1] * A[M1,M]; "IF" ABS(DELTA) < MACHTOL "THEN" S:= SQRT(DET) "ELSE" "BEGIN" W:= 2 / DELTA; S:= W * W * DET + 1; S:= "IF" S <= 0 "THEN" -DELTA * .5 "ELSE" W * DET / (SQRT(S) + 1) "END"; "IF" Q = M1 "THEN" "BEGIN" A[M,M]:= VAL[M]:= A[M,M] + S; A[Q,Q]:= VAL[Q]:= A[Q,Q] - S; T:= "IF" ABS(S) < MACHTOL "THEN" (S + DELTA) / A[M,Q] "ELSE" A[Q,M] / S; R:= SQRT(T * T + 1); NU:= 1 / R; MU:= -T * NU; A[Q,M]:= A[Q,M] - A[M,Q]; ROTROW(Q + 2, N, Q, M, A, MU, NU); ROTCOL(1, Q - 1, Q, M, A, MU, NU); ROTCOL(1, N, Q, M, VEC, MU, NU); M:= M - 2 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" END; SHIFT:= A[M,M] + S; "IF" ABS(DELTA) < TOL "THEN" "BEGIN" W:= A[M1,M1] - S; "IF" ABS(W) < ABS(SHIFT) "THEN" SHIFT:= W "END"; A[Q,Q]:= A[Q,Q] - SHIFT; "FOR" I:= Q "STEP" 1 "UNTIL" M1 "DO" "BEGIN" I1:= I + 1; A[I1,I1]:= A[I1,I1] - SHIFT; KAPPA:= SQRT(A[I,I] ** 2 + A[I1,I] ** 2); "IF" I > Q "THEN" "BEGIN" A[I,I - 1]:= KAPPA * NU; W:= KAPPA * MU "END" "ELSE" W:= KAPPA; MU:= A[I,I] / KAPPA; NU:= A[I1,I] / KAPPA; A[I,I]:= W; ROTROW(I1, N, I, I1, A, MU, NU); ROTCOL(1, I, I, I1, A, MU, NU); A[I,I]:= A[I,I] + SHIFT; ROTCOL(1, N, I, I1, VEC, MU, NU) "END"; A[M,M1]:= A[M,M] * NU; A[M,M]:= A[M,M] * MU + SHIFT "END" "END"; "IF" M > 0 "THEN" "GOTO" IN; "FOR" J:= N "STEP" -1 "UNTIL" 2 "DO" "BEGIN" TF[J]:= 1; T:= A[J,J]; "FOR" I:= J - 1 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" DELTA:= T - A[I,I]; TF[I]:= MATVEC(I + 1, J, I, A, TF) / ("IF" ABS(DELTA) < MACHTOL "THEN" MACHTOL "ELSE" DELTA) "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" VEC[I,J]:= MATVEC(1, J, I, VEC, TF) "END"; END: EM[3]:= ELMAX; EM[5]:= COUNT; REAQRI:= M "END" REAQRI; "COMMENT" ================== 34190 =================; "COMMENT" MCA 2420; "INTEGER" "PROCEDURE" COMVALQRI(A, N, EM, RE, IM); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, RE, IM; "BEGIN" "INTEGER" I, J, P, Q, MAX, COUNT, N1, P1, P2, IMIN1, I1, I2, I3; "REAL" DISC, SIGMA, RHO, G1, G2, G3, PSI1, PSI2, AA, E, K, S, NORM, MACHTOL2, TOL, W; "BOOLEAN" B; NORM:= EM[1]; MACHTOL2:= (EM[0] * NORM) ** 2; TOL:= EM[2] * NORM; MAX:= EM[4]; COUNT:= 0; W:= 0; IN: "FOR" I:= N, I - 1 "WHILE" ("IF" I >= 1 "THEN" ABS(A[I + 1,I]) > TOL "ELSE" "FALSE") "DO" Q:= I; "IF" Q > 1 "THEN" "BEGIN" "IF" ABS(A[Q,Q - 1]) > W "THEN" W:= ABS(A[Q,Q - 1]) "END"; "IF" Q >= N - 1 "THEN" "BEGIN" N1:= N - 1; "IF" Q = N "THEN" "BEGIN" RE[N]:= A[N,N]; IM[N]:= 0; N:= N1 "END" "ELSE" "BEGIN" SIGMA:= A[N,N] - A[N1,N1]; RHO:= -A[N,N1] * A[N1,N]; DISC:= SIGMA ** 2 - 4 * RHO; "IF" DISC > 0 "THEN" "BEGIN" DISC:= SQRT(DISC); S:= -2 * RHO / (SIGMA + ("IF" SIGMA >= 0 "THEN" DISC "ELSE" -DISC)); RE[N]:= A[N,N] + S; RE[N1]:= A[N1,N1] - S; IM[N]:= IM[N1]:= 0 "END" "ELSE" "BEGIN" RE[N]:= RE[N1]:= (A[N1,N1] + A[N,N]) / 2; IM[N1]:= SQRT( -DISC) / 2; IM[N]:= -IM[N1] "END"; N:= N - 2 "END" "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" OUT; N1:= N - 1; SIGMA:= A[N,N] + A[N1,N1] + SQRT(ABS(A[N1,N - 2] * A[N,N1]) * EM[0]); RHO:= A[N,N] * A[N1,N1] - A[N,N1] * A[N1,N]; "FOR" I:= N - 1, I - 1 "WHILE" ("IF" I - 1 >= Q "THEN" ABS(A[I,I - 1] * A[I1,I] * (ABS(A[I,I] + A[I1,I1] - SIGMA) + ABS(A[I + 2,I1]))) > ABS(A[I,I] * ((A[I,I] - SIGMA) + A[I,I1] * A[I1,I] + RHO)) * TOL "ELSE" "FALSE") "DO" P1:= I1:= I; P:= P1 - 1; P2:= P + 2; "FOR" I:= P "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" IMIN1:= I - 1; I1:= I + 1; I2:= I + 2; "IF" I = P "THEN" "BEGIN" G1:= A[P,P] * (A[P,P] - SIGMA) + A[P,P1] * A[P1,P] + RHO; G2:= A[P1,P] * (A[P,P] + A[P1,P1] - SIGMA); "IF" P1 <= N1 "THEN" "BEGIN" G3:= A[P1,P] * A[P2,P1]; A[P2,P]:= 0 "END" "ELSE" G3:= 0 "END" "ELSE" "BEGIN" G1:= A[I,IMIN1]; G2:= A[I1,IMIN1]; G3:= "IF" I2 <= N "THEN" A[I2,IMIN1] "ELSE" 0 "END"; K:= "IF" G1 >= 0 "THEN" SQRT(G1 ** 2 + G2 ** 2 + G3 ** 2) "ELSE" -SQRT(G1 ** 2 + G2 ** 2 + G3 ** 2); B:= ABS(K) > MACHTOL2; AA:= "IF" B "THEN" G1 / K + 1 "ELSE" 2; PSI1:= "IF" B "THEN" G2 / (G1 + K) "ELSE" 0; PSI2:= "IF" B "THEN" G3 / (G1 + K) "ELSE" 0; "IF" I ^= Q "THEN" A[I,IMIN1]:= "IF" I = P "THEN" -A[I,IMIN1] "ELSE" -K; "FOR" J:= I "STEP" 1 "UNTIL" N "DO" "BEGIN" E:= AA * (A[I,J] + PSI1 * A[I1,J] + ("IF" I2 <= N "THEN" PSI2 * A[I2,J] "ELSE" 0)); A[I,J]:= A[I,J] - E; A[I1,J]:= A[I1,J] - PSI1 * E; "IF" I2 <= N "THEN" A[I2,J]:= A[I2,J] - PSI2 * E "END"; "FOR" J:= Q "STEP" 1 "UNTIL" ("IF" I2 <= N "THEN" I2 "ELSE" N) "DO" "BEGIN" E:= AA * (A[J,I] + PSI1 * A[J,I1] + ("IF" I2 <= N "THEN" PSI2 * A[J,I2] "ELSE" 0)); A[J,I]:= A[J,I] - E; A[J,I1]:= A[J,I1] - PSI1 * E; "IF" I2 <= N "THEN" A[J,I2]:= A[J,I2] - PSI2 * E "END"; "IF" I2 <= N1 "THEN" "BEGIN" I3:= I + 3; E:= AA * PSI2 * A[I3,I2]; A[I3,I]:= -E; A[I3,I1]:= -PSI1 * E; A[I3,I2]:= A[I3,I2] - PSI2 * E "END" "END" "END"; "IF" N > 0 "THEN" "GOTO" IN; OUT: EM[3]:= W; EM[5]:= COUNT; COMVALQRI:= N "END" COMVALQRI; "COMMENT" ================== 34191 =================; "COMMENT" MCA 2421; "PROCEDURE" COMVECHES(A, N, LAMBDA, MU, EM, U, V); "VALUE" N, LAMBDA, MU; "INTEGER" N; "REAL" LAMBDA, MU; "ARRAY" A, EM, U, V; "BEGIN" "INTEGER" I, I1, J, COUNT, MAX; "REAL" AA, BB, D, M, R, S, W, X, Y, NORM, MACHTOL, TOL; "ARRAY" G, F[1:N]; "BOOLEAN" "ARRAY" P[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; NORM:= EM[1]; MACHTOL:= EM[0] * NORM; TOL:= EM[6] * NORM; MAX:= EM[8]; "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" F[I - 1]:= A[I,I - 1]; A[I,1]:= 0 "END"; AA:= A[1,1] - LAMBDA; BB:= -MU; "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" I1:= I + 1; M:= F[I]; "IF" ABS(M) < MACHTOL "THEN" M:= MACHTOL; A[I,I]:= M; D:= AA ** 2 + BB ** 2; P[I]:= ABS(M) < SQRT(D); "IF" P[I] "THEN" "BEGIN" "COMMENT" A[I,J] * FACTOR AND A[I1,J] - A[I,J]; F[I]:= R:= M * AA / D; G[I]:= S:= -M * BB / D; W:= A[I1,I]; X:= A[I,I1]; A[I1,I]:= Y:= X * S + W * R; A[I,I1]:= X:= X * R - W * S; AA:= A[I1,I1] - LAMBDA - X; BB:= -(MU + Y); "FOR" J:= I + 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= A[J,I]; X:= A[I,J]; A[J,I]:= Y:= X * S + W * R; A[I,J]:= X:= X * R - W * S; A[J,I1]:= -Y; A[I1,J]:= A[I1,J] - X "END" "END" "ELSE" "BEGIN" "COMMENT" INTERCHANGE A[I1,J] AND A[I,J] - A[I1,J] * FACTOR; F[I]:= R:= AA / M; G[I]:= S:= BB / M; W:= A[I1,I1] - LAMBDA; AA:= A[I,I1] - R * W - S * MU; A[I,I1]:= W; BB:= A[I1,I] - S * W + R * MU; A[I1,I]:= -MU; "FOR" J:= I + 2 "STEP" 1 "UNTIL" N "DO" "BEGIN" W:= A[I1,J]; A[I1,J]:= A[I,J] - R * W; A[I,J]:= W; A[J,I1]:= A[J,I] - S * W; A[J,I]:= 0 "END" "END" "END" P[N]:= "TRUE"; D:= AA ** 2 + BB ** 2; "IF" D < MACHTOL ** 2 "THEN" "BEGIN" AA:= MACHTOL; BB:= 0; D:= MACHTOL ** 2 "END"; A[N,N]:= D; F[N]:= AA; G[N]:= -BB; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" U[I]:= 1; V[I]:= 0 "END"; COUNT:= 0; FORWARD: "IF" COUNT > MAX "THEN" "GOTO" OUTM; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" P[I] "THEN" "BEGIN" W:= V[I]; V[I]:= G[I] * U[I] + F[I] * W; U[I]:= F[I] * U[I] - G[I] * W; "IF" I < N "THEN" "BEGIN" V[I + 1]:= V[I + 1] - V[I]; U[I + 1]:= U[I + 1] - U[I] "END" "END" "ELSE" "BEGIN" AA:= U[I + 1]; BB:= V[I + 1]; U[I + 1]:= U[I] - (F[I] * AA - G[I] * BB); U[I]:= AA; V[I + 1]:= V[I] - (G[I] * AA + F[I] * BB); V[I]:= BB "END" "END" FORWARD; BACKWARD: "FOR" I:= N "STEP" -1 "UNTIL" 1 "DO" "BEGIN" I1:= I + 1; U[I]:= (U[I] - MATVEC(I1, N, I, A, U) + ("IF" P[I] "THEN" TAMVEC(I1, N, I, A, V) "ELSE" A[I1,I] * V[I1])) / A[I,I]; V[I]:= (V[I] - MATVEC(I1, N, I, A, V) - ("IF" P[I] "THEN" TAMVEC(I1, N, I, A, U) "ELSE" A[I1,I] * U[I1])) / A[I,I] "END" BACKWARD; NORMALISE: W:= 1 / SQRT(VECVEC(1, N, 0, U, U) + VECVEC(1, N, 0, V, V)); "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" U[J]:= U[J] * W; V[J]:= V[J] * W "END"; COUNT:= COUNT + 1; "IF" W > TOL "THEN" "GOTO" FORWARD; OUTM: EM[7]:= W; EM[9]:= COUNT "END" COMVECHES; "COMMENT" ================== 34182 =================; "COMMENT" MCA 2412; "INTEGER" "PROCEDURE" REAEIGVAL(A, N, EM, VAL); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, VAL; "BEGIN" "INTEGER" I, J; "REAL" R; "ARRAY" D[1:N]; "INTEGER" "ARRAY" INT, INT0[1:N]; "PROCEDURE" TFMREAHES(A, N, EM, INT); "CODE" 34170; "PROCEDURE" EQILBR(A, N, EM, D, INT); "CODE" 34173; "INTEGER" "PROCEDURE" REAVALQRI(A, N, EM, VAL); "CODE" 34180; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); J:= REAEIGVAL:= REAVALQRI(A, N, EM, VAL); "FOR" I:= J + 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= I + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" VAL[J] > VAL[I] "THEN" "BEGIN" R:= VAL[I]; VAL[I]:= VAL[J]; VAL[J]:= R "END" "END" "END" REAEIGVAL; "COMMENT" ================== 34184 =================; "COMMENT" MCA 2414; "INTEGER" "PROCEDURE" REAEIG1(A, N, EM, VAL, VEC); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, VAL, VEC; "BEGIN" "INTEGER" I, K, MAX, J, L; "REAL" RESIDU, R, MACHTOL; "ARRAY" D, V[1:N], B[1:N,1:N]; "INTEGER" "ARRAY" INT, INT0[1:N]; "PROCEDURE" TFMREAHES(A, N, EM, INT); "CODE" 34170; "PROCEDURE" BAKREAHES2(A, N, N1, N2, INT, VEC); "CODE" 34172; "PROCEDURE" EQILBR(A, N, EM, D, INT); "CODE" 34173; "PROCEDURE" BAKLBR(N, N1, N2, D, INT, VEC); "CODE" 34174; "INTEGER" "PROCEDURE" REAVALQRI(A, N, EM, VAL); "CODE" 34180; "PROCEDURE" REAVECHES(A, N, LAMBDA, EM, V); "CODE" 34181; "PROCEDURE" REASCL(A, N, N1, N2); "CODE" 34183; RESIDU:= 0; MAX:= 0; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= ("IF" I = 1 "THEN" 1 "ELSE" I - 1) "STEP" 1 "UNTIL" N "DO" B[I,J]:= A[I,J]; K:= REAEIG1:= REAVALQRI(B, N, EM, VAL); "FOR" I:= K + 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= I + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" VAL[J] > VAL[I] "THEN" "BEGIN" R:= VAL[I]; VAL[I]:= VAL[J]; VAL[J]:= R "END" "END"; MACHTOL:= EM[0] * EM[1]; "FOR" L:= K + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" L > 1 "THEN" "BEGIN" "IF" VAL[L - 1] - VAL[L] < MACHTOL "THEN" VAL[L]:= VAL[L - 1] - MACHTOL "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= ("IF" I = 1 "THEN" 1 "ELSE" I - 1) "STEP" 1 "UNTIL" N "DO" B[I,J]:= A[I,J]; REAVECHES(B, N, VAL[L], EM, V); "IF" EM[7] > RESIDU "THEN" RESIDU:= EM[7]; "IF" EM[9] > MAX "THEN" MAX:= EM[9]; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" VEC[J,L]:= V[J] "END"; EM[7]:= RESIDU; EM[9]:= MAX; BAKREAHES2(A, N, K + 1, N, INT, VEC); BAKLBR(N, K + 1, N, D, INT0, VEC); REASCL(VEC, N, K + 1, N) "END" REAEIG1; "COMMENT" ================== 34187 =================; "COMMENT" MCA 2417; "INTEGER" "PROCEDURE" REAEIG3(A, N, EM, VAL, VEC); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, VAL, VEC; "BEGIN" "INTEGER" I; "REAL" S; "INTEGER" "ARRAY" INT, INT0[1:N]; "ARRAY" D[1:N]; "PROCEDURE" TFMREAHES(A, N, EM, INT); "CODE" 34170; "PROCEDURE" BAKREAHES2(A, N, N1, N2, INT, VEC); "CODE" 34172; "PROCEDURE" EQILBR(A, N, EM, D, INT); "CODE" 34173; "PROCEDURE" BAKLBR(N, N1, N2, D, INT, VEC); "CODE" 34174; "PROCEDURE" REASCL(A, N, N1, N2); "CODE" 34183; "INTEGER" "PROCEDURE" REAQRI(A, N, EM, VAL, VEC); "CODE" 34186; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); I:= REAEIG3:= REAQRI(A, N, EM, VAL, VEC); "IF" I = 0 "THEN" "BEGIN" BAKREAHES2(A, N, 1, N, INT, VEC); BAKLBR(N, 1, N, D, INT0, VEC); REASCL(VEC, N, 1, N) "END" "END" REAEIG3; "COMMENT" ================== 34192 =================; "COMMENT" MCA 2422; "INTEGER" "PROCEDURE" COMEIGVAL(A, N, EM, RE, IM); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, RE, IM; "BEGIN" "INTEGER" "ARRAY" INT, INT0[1:N]; "ARRAY" D[1:N]; "PROCEDURE" EQILBR(A, N, EM, D, INT); "CODE" 34173; "PROCEDURE" TFMREAHES(A, N, EM, INT); "CODE" 34170; "INTEGER" "PROCEDURE" COMVALQRI(A, N, EM, RE, IM); "CODE" 34190; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); COMEIGVAL:= COMVALQRI(A, N, EM, RE, IM) "END" COMEIGVAL; "COMMENT" ================== 34194 =================; "COMMENT" MCA 2424; "INTEGER" "PROCEDURE" COMEIG1(A, N, EM, RE, IM, VEC); "VALUE" N; "INTEGER" N; "ARRAY" A, EM, RE, IM, VEC; "BEGIN" "INTEGER" I, J, K, PJ, ITT; "REAL" X, Y, MAX, NEPS; "ARRAY" AB[1:N,1:N], D, U, V[1:N]; "INTEGER" "ARRAY" INT, INT0[1:N]; "PROCEDURE" TRANSFER; "BEGIN" "INTEGER" I, J; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "FOR" J:= ("IF" I = 1 "THEN" 1 "ELSE" I - 1) "STEP" 1 "UNTIL" N "DO" AB[I,J]:= A[I,J] "END" TRANSFER; "PROCEDURE" EQILBR(A, N, EM, D, INT); "CODE" 34173; "PROCEDURE" TFMREAHES(A, N, EM, INT); "CODE" 34170; "PROCEDURE" BAKREAHES2(A, N, N1, N2, INT, VEC); "CODE" 34172; "PROCEDURE" BAKLBR(N, N1, N2, D, INT, VEC); "CODE" 34174; "PROCEDURE" REAVECHES(A, N, LAMBDA, EM, V); "CODE" 34181; "PROCEDURE" COMSCL(A, N, N1, N2, IM); "CODE" 34193; "INTEGER" "PROCEDURE" COMVALQRI(A, N, EM, RE, IM); "CODE" 34190; "PROCEDURE" COMVECHES(A, N, LAMBDA, MU, EM, U, V); "CODE" 34191; EQILBR(A, N, EM, D, INT0); TFMREAHES(A, N, EM, INT); TRANSFER; K:= COMEIG1:= COMVALQRI(AB, N, EM, RE, IM); NEPS:= EM[0] * EM[1]; MAX:= 0; ITT:= 0; "FOR" I:= K + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" X:= RE[I]; Y:= IM[I]; PJ:= 0; AGAIN: "FOR" J:= K + 1 "STEP" 1 "UNTIL" I - 1 "DO" "BEGIN" "IF" ((X - RE[J]) ** 2 + (Y - IM[J]) ** 2 <= NEPS ** 2) "THEN" "BEGIN" "IF" PJ = J "THEN" NEPS:= EM[2] * EM[1] "ELSE" PJ:= J; X:= X + 2 * NEPS; "GOTO" AGAIN "END" "END"; RE[I]:= X; TRANSFER; "IF" Y ^= 0 "THEN" "BEGIN" COMVECHES(AB, N, RE[I], IM[I], EM, U, V); "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" VEC[J,I]:= U[J]; I:= I + 1; RE[I]:= X "END" "ELSE" REAVECHES(AB, N, X, EM, V); "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" VEC[J,I]:= V[J]; "IF" EM[7] > MAX "THEN" MAX:= EM[7]; ITT:= "IF" ITT > EM[9] "THEN" ITT "ELSE" EM[9] "END"; EM[7]:= MAX; EM[9]:= ITT; BAKREAHES2(A, N, K + 1, N, INT, VEC); BAKLBR(N, K + 1, N, D, INT0, VEC); COMSCL(VEC, N, K + 1, N, IM) "END" COMEIG1; "COMMENT" ================== 34368 =================; "PROCEDURE" EIGVALHRM(A, N, NUMVAL, VAL, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" D[1:N], BB[1:N - 1]; "PROCEDURE" HSHHRMTRIVAL(A,N,D,BB,EM);"CODE" 34364; "PROCEDURE" VALSYMTRI(D,BB,N,N1,N2,VAL,EM);"CODE" 34151; HSHHRMTRIVAL(A, N, D, BB, EM); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM) "END" EIGVALHRM; "COMMENT" ================== 34369 =================; "PROCEDURE" EIGHRM(A, N, NUMVAL, VAL, VECR, VECI, EM); "VALUE" N, NUMVAL; "INTEGER" N, NUMVAL; "ARRAY" A, VAL, VECR, VECI, EM; "BEGIN" "ARRAY" BB, TR, TI[1:N - 1], D, B[1:N]; "PROCEDURE" HSHHRMTRI(A,N,D,B,BB,EM,TR,TI);"CODE" 34363; "PROCEDURE" VALSYMTRI(D,BB,N,N1,N2,VAL,EM);"CODE" 34151; "PROCEDURE" VECSYMTRI(D,B,N,N1,N2,VAL,VEC,EM);"CODE" 34152; "PROCEDURE" BAKHRMTRI(A,N,N1,N2,VECR,VECI,TR,TI);"CODE" 34365; HSHHRMTRI(A, N, D, B, BB, EM, TR, TI); VALSYMTRI(D, BB, N, 1, NUMVAL, VAL, EM); B[N]:= 0; VECSYMTRI(D, B, N, 1, NUMVAL, VAL, VECR, EM); BAKHRMTRI(A, N, 1, NUMVAL, VECR, VECI, TR, TI) "END" EIGHRM; "COMMENT" ================== 34370 =================; "INTEGER" "PROCEDURE" QRIVALHRM(A, N, VAL, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B,BB[1:N]; "INTEGER" I; "PROCEDURE" HSHHRMTRIVAL(A,N,D,BB,EM);"CODE" 34364; "INTEGER" "PROCEDURE" QRIVALSYMTRI(D, BB, N, EM);"CODE" 34160; HSHHRMTRIVAL(A, N, VAL, BB, EM); B[N]:=BB[N]:= 0; "FOR" I:=1 "STEP" 1 "UNTIL" N-1 "DO" B[I]:=SQRT(BB[I]); QRIVALHRM:=QRIVALSYMTRI(VAL, BB, N, EM) "END" QRIVALHRM; "COMMENT" ================== 34371 =================; "INTEGER" "PROCEDURE" QRIHRM(A, N, VAL, VR, VI, EM); "VALUE" N; "INTEGER" N; "ARRAY" A, VAL, VR, VI, EM; "BEGIN" "INTEGER" I, J; "ARRAY" B, BB[1:N], TR, TI[1:N - 1]; "PROCEDURE" HSHHRMTRI(A,N,D,B,BB,EM,TR,TI);"CODE" 34363; "INTEGER" "PROCEDURE" QRISYMTRI(A,N,D,B,BB,EM);"CODE" 34161; "PROCEDURE" BAKHRMTRI(A,N,N1,N2,VECR,VECI,TR,TI);"CODE" 34365; HSHHRMTRI(A, N, VAL, B, BB, EM, TR, TI); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" VR[I,I]:= 1; "FOR" J:= I + 1 "STEP" 1 "UNTIL" N "DO" VR[I,J]:= VR[J,I]:= 0 "END"; B[N]:= BB[N]:= 0; I:= QRIHRM:= QRISYMTRI(VR, N, VAL, B, BB, EM); BAKHRMTRI(A, N, I+1, N, VR, VI, TR, TI); "END" QRIHRM; "COMMENT" ================== 34372 =================; "INTEGER" "PROCEDURE" VALQRICOM(A1, A2, B, N, EM, VAL1, VAL2); "VALUE" N; "INTEGER" N; "ARRAY" A1, A2, B, EM, VAL1, VAL2; "BEGIN" "INTEGER" M, NM1, I, I1, Q, Q1, MAX, COUNT; "REAL" R, Z1, Z2, DD1, DD2, CC, G1, G2, K1, K2, HC, A1NN, A2NN, AIJ1, AIJ2, AI1I, KAPPA, NUI, MUI1, MUI2, MUIM11, MUIM12, NUIM1, TOL; "PROCEDURE" COMCOLCST(L,U,J,AR,AI,XR,XI);"CODE" 34352; "PROCEDURE" ROTCOMCOL(L,U,I,J,AR,AI,CR,CI,S);"CODE" 34357; "PROCEDURE" ROTCOMROW(L,U,I,J,AR,AI,CR,CI,S);"CODE" 34358; "PROCEDURE" COMKWD(PR,PI,QR,QI,GR,GI,KR,KI);"CODE" 34345; TOL:= EM[1] * EM[2]; MAX:= EM[4]; COUNT:= 0; R:= 0; M:= N; "IF" N > 1 "THEN" HC:= B[N - 1]; IN: NM1:= N - 1; "FOR" I:= N, I - 1 "WHILE" ("IF" I >= 1 "THEN" ABS(B[I]) > TOL "ELSE" "FALSE") "DO" Q:= I; "IF" Q > 1 "THEN" "BEGIN" "IF" ABS(B[Q - 1]) > R "THEN" R:= ABS(B[Q - 1]) "END"; "IF" Q = N "THEN" "BEGIN" VAL1[N]:= A1[N,N]; VAL2[N]:= A2[N,N]; N:= NM1; "IF" N > 1 "THEN" HC:= B[N - 1]; "END" "ELSE" "BEGIN" DD1:= A1[N,N]; DD2:= A2[N,N]; CC:= B[NM1]; COMKWD((A1[NM1,NM1] - DD1) / 2, (A2[NM1,NM1] - DD2) / 2, CC * A1[NM1,N], CC * A2[NM1,N], G1, G2, K1, K2); "IF" Q = NM1 "THEN" "BEGIN" VAL1[NM1]:= G1 + DD1; VAL2[NM1]:= G2 + DD2; VAL1[N]:= K1 + DD1; VAL2[N]:= K2 + DD2; N:= N - 2; "IF" N > 1 "THEN" HC:= B[N - 1]; "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" OUT; Z1:= K1 + DD1; Z2:= K2 + DD2; "IF" ABS(CC) > ABS(HC) "THEN" Z1:= Z1 + ABS(CC); HC:= CC / 2; I:= Q1:= Q + 1; AIJ1:= A1[Q,Q] - Z1; AIJ2:= A2[Q,Q] - Z2; AI1I:= B[Q]; KAPPA:= SQRT(AIJ1 ** 2 + AIJ2 ** 2 + AI1I ** 2); MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; NUI:= AI1I / KAPPA; A1[Q,Q]:= KAPPA; A2[Q,Q]:= 0; A1[Q1,Q1]:= A1[Q1,Q1] - Z1; A2[Q1,Q1]:= A2[Q1,Q1] - Z2; ROTCOMROW(Q1, N, Q, Q1, A1, A2, MUI1, MUI2, NUI); ROTCOMCOL(Q, Q, Q, Q1, A1, A2, MUI1, - MUI2, - NUI); A1[Q,Q]:= A1[Q,Q] + Z1; A2[Q,Q]:= A2[Q,Q] + Z2; "FOR" I1:= Q1 + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" AIJ1:= A1[I,I]; AIJ2:= A2[I,I]; AI1I:= B[I]; KAPPA:= SQRT(AIJ1 ** 2 + AIJ2 ** 2 + AI1I ** 2); MUIM11:= MUI1; MUIM12:= MUI2; NUIM1:= NUI; MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; NUI:= AI1I / KAPPA; A1[I1,I1]:= A1[I1,I1] - Z1; A2[I1,I1]:= A2[I1,I1] - Z2; ROTCOMROW(I1, N, I, I1, A1, A2, MUI1, MUI2, NUI); A1[I,I]:= MUIM11 * KAPPA; A2[I,I]:= - MUIM12 * KAPPA; B[I - 1]:= NUIM1 * KAPPA; ROTCOMCOL(Q, I, I, I1, A1, A2, MUI1, - MUI2, - NUI); A1[I,I]:= A1[I,I] + Z1; A2[I,I]:= A2[I,I] + Z2; I:= I1; "END"; AIJ1:= A1[N,N]; AIJ2:= A2[N,N]; KAPPA:= SQRT(AIJ1 ** 2 + AIJ2 ** 2); "IF" ("IF" KAPPA < TOL "THEN" "TRUE" "ELSE" AIJ2 ** 2 <= EM[0] * AIJ1 ** 2) "THEN" "BEGIN" B[NM1]:= NUI * AIJ1; A1[N,N]:= AIJ1 * MUI1 + Z1; A2[N,N]:= - AIJ1 * MUI2 + Z2 "END" "ELSE" "BEGIN" B[NM1]:= NUI * KAPPA; A1NN:= MUI1 * KAPPA; A2NN:= - MUI2 * KAPPA; MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; COMCOLCST(Q, NM1, N, A1, A2, MUI1, MUI2); A1[N,N]:= MUI1 * A1NN - MUI2 * A2NN + Z1; A2[N,N]:= MUI1 * A2NN + MUI2 * A1NN + Z2; "END"; "END" "END"; "IF" N > 0 "THEN" "GOTO" IN; OUT: EM[3]:= R; EM[5]:= COUNT; VALQRICOM:= N; "END" VALQRICOM; "COMMENT" ================== 34373 =================; "INTEGER" "PROCEDURE" QRICOM(A1, A2, B, N, EM, VAL1, VAL2, VEC1, VEC2); "VALUE" N; "INTEGER" N; "ARRAY" A1, A2, B, EM, VAL1, VAL2, VEC1, VEC2; "BEGIN" "INTEGER" M, NM1, I, I1, J, Q, Q1, MAX, COUNT; "REAL" R, Z1, Z2, DD1, DD2, CC, P1, P2, T1, T2, DELTA1, DELTA2, MV1, MV2, H, H1, H2, G1, G2, K1, K2, HC, AIJ12, AIJ22, A1NN, A2NN, AIJ1, AIJ2, AI1I, KAPPA, NUI, MUI1, MUI2, MUIM11, MUIM12, NUIM1, TOL, MACHTOL; "ARRAY" TF1, TF2[1:N]; "PROCEDURE" COMKWD(PR,PI,QR,QI,GR,GI,KR,KI);"CODE" 34345; "PROCEDURE" ROTCOMROW(L,U,I,J,AR,AI,CR,CI,S);"CODE" 34358; "PROCEDURE" ROTCOMCOL(L,U,I,J,AR,AI,CR,CI,S);"CODE" 34357; "PROCEDURE" COMCOLCST(L,U,J,AR,AI,XR,XI);"CODE" 34352; "PROCEDURE" COMROWCST(L,U,I,AR,AI,XR,XI);"CODE" 34353; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);"CODE" 34011; "PROCEDURE" COMMATVEC(L,U,I,AR,AI,BR,BI,RR,RI);"CODE" 34354; "PROCEDURE" COMDIV(XR,XI,YR,YI,ZR,ZI);"CODE" 34342; TOL:= EM[1] * EM[2]; MACHTOL:= EM[0] * EM[1]; MAX:= EM[4]; COUNT:= 0; R:= 0; M:= N; "IF" N > 1 "THEN" HC:= B[N - 1]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" VEC1[I,I]:= 1; VEC2[I,I]:= 0; "FOR" J:= I + 1 "STEP" 1 "UNTIL" N "DO" VEC1[I,J]:= VEC1[J,I]:= VEC2[I,J]:= VEC2[J,I]:= 0 "END"; IN: NM1:= N - 1; "FOR" I:= N, I - 1 "WHILE" ("IF" I >= 1 "THEN" ABS(B[I]) > TOL "ELSE" "FALSE") "DO" Q:= I; "IF" Q > 1 "THEN" "BEGIN" "IF" ABS(B[Q - 1]) > R "THEN" R:= ABS(B[Q - 1]) "END"; "IF" Q = N "THEN" "BEGIN" VAL1[N]:= A1[N,N]; VAL2[N]:= A2[N,N]; N:= NM1; "IF" N > 1 "THEN" HC:= B[N - 1]; "END" "ELSE" "BEGIN" DD1:= A1[N,N]; DD2:= A2[N,N]; CC:= B[NM1]; P1:= (A1[NM1,NM1] - DD1) * .5; P2:= (A2[NM1,NM1] - DD2) * .5; COMKWD(P1, P2, CC * A1[NM1,N], CC * A2[NM1,N], G1, G2, K1, K2); "IF" Q = NM1 "THEN" "BEGIN" A1[N,N]:= VAL1[N]:= G1 + DD1; A2[N,N]:= VAL2[N]:= G2 + DD2; A1[Q,Q]:= VAL1[Q]:= K1 + DD1; A2[Q,Q]:= VAL2[Q]:= K2 + DD2; KAPPA:= SQRT(K1 ** 2 + K2 ** 2 + CC ** 2); NUI:= CC / KAPPA; MUI1:= K1 / KAPPA; MUI2:= K2 / KAPPA; AIJ1:= A1[Q,N]; AIJ2:= A2[Q,N]; H1:= MUI1 ** 2 - MUI2 ** 2; H2:= 2 * MUI1 * MUI2; H:= - NUI * 2; A1[Q,N]:= H * (P1 * MUI1 + P2 * MUI2) - NUI * NUI * CC + AIJ1 * H1 + AIJ2 * H2; A2[Q,N]:= H * (P2 * MUI1 - P1 * MUI2) + AIJ2 * H1 - AIJ1 * H2; ROTCOMROW(Q + 2, M, Q, N, A1, A2, MUI1, MUI2, NUI); ROTCOMCOL(1, Q - 1, Q, N, A1, A2, MUI1, - MUI2, - NUI); ROTCOMCOL(1, M, Q, N, VEC1, VEC2, MUI1, - MUI2, - NUI); N:= N - 2; "IF" N > 1 "THEN" HC:= B[N - 1]; B[Q]:= 0 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" OUT; Z1:= K1 + DD1; Z2:= K2 + DD2; "IF" ABS(CC) > ABS(HC) "THEN" Z1:= Z1 + ABS(CC); HC:= CC / 2; Q1:= Q + 1; AIJ1:= A1[Q,Q] - Z1; AIJ2:= A2[Q,Q] - Z2; AI1I:= B[Q]; KAPPA:= SQRT(AIJ1 ** 2 + AIJ2 ** 2 + AI1I ** 2); MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; NUI:= AI1I / KAPPA; A1[Q,Q]:= KAPPA; A2[Q,Q]:= 0; A1[Q1,Q1]:= A1[Q1,Q1] - Z1; A2[Q1,Q1]:= A2[Q1,Q1] - Z2; ROTCOMROW(Q1, M, Q, Q1, A1, A2, MUI1, MUI2, NUI); ROTCOMCOL(1, Q, Q, Q1, A1, A2, MUI1, - MUI2, - NUI); A1[Q,Q]:= A1[Q,Q] + Z1; A2[Q,Q]:= A2[Q,Q] + Z2; ROTCOMCOL(1, M, Q, Q1, VEC1, VEC2, MUI1, - MUI2, - NUI); "FOR" I:= Q1 "STEP" 1 "UNTIL" NM1 "DO" "BEGIN" I1:= I + 1; AIJ1:= A1[I,I]; AIJ2:= A2[I,I]; AI1I:= B[I]; KAPPA:= SQRT(AIJ1 ** 2 + AIJ2 ** 2 + AI1I ** 2); MUIM11:= MUI1; MUIM12:= MUI2; NUIM1:= NUI; MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; NUI:= AI1I / KAPPA; A1[I1,I1]:= A1[I1,I1] - Z1; A2[I1,I1]:= A2[I1,I1] - Z2; ROTCOMROW(I1, M, I, I1, A1, A2, MUI1, MUI2, NUI); A1[I,I]:= MUIM11 * KAPPA; A2[I,I]:= - MUIM12 * KAPPA; B[I - 1]:= NUIM1 * KAPPA; ROTCOMCOL(1, I, I, I1, A1, A2, MUI1, - MUI2, - NUI); A1[I,I]:= A1[I,I] + Z1; A2[I,I]:= A2[I,I] + Z2; ROTCOMCOL(1, M, I, I1, VEC1, VEC2, MUI1, - MUI2, - NUI); "END"; AIJ1:= A1[N,N]; AIJ2:= A2[N,N]; AIJ12:= AIJ1 ** 2; AIJ22:= AIJ2 ** 2; KAPPA:= SQRT(AIJ12 + AIJ22); "IF" ("IF" KAPPA < TOL "THEN" "TRUE" "ELSE" AIJ22 <= EM[0] * AIJ12) "THEN" "BEGIN" B[NM1]:= NUI * AIJ1; A1[N,N]:= AIJ1 * MUI1 + Z1; A2[N,N]:= - AIJ1 * MUI2 + Z2 "END" "ELSE" "BEGIN" B[NM1]:= NUI * KAPPA; A1NN:= MUI1 * KAPPA; A2NN:= - MUI2 * KAPPA; MUI1:= AIJ1 / KAPPA; MUI2:= AIJ2 / KAPPA; COMCOLCST(1, NM1, N, A1, A2, MUI1, MUI2); COMCOLCST(1, NM1, N, VEC1, VEC2, MUI1, MUI2); COMROWCST(N + 1, M, N, A1, A2, MUI1, - MUI2); COMCOLCST(N, M, N, VEC1, VEC2, MUI1, MUI2); A1[N,N]:= MUI1 * A1NN - MUI2 * A2NN + Z1; A2[N,N]:= MUI1 * A2NN + MUI2 * A1NN + Z2; "END"; "END"; "END"; "IF" N > 0 "THEN" "GOTO" IN; "FOR" J:= M "STEP" - 1 "UNTIL" 2 "DO" "BEGIN" TF1[J]:= 1; TF2[J]:= 0; T1:= A1[J,J]; T2:= A2[J,J]; "FOR" I:= J - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" DELTA1:= T1 - A1[I,I]; DELTA2:= T2 - A2[I,I]; COMMATVEC(I + 1, J, I, A1, A2, TF1, TF2, MV1, MV2); "IF" ABS(DELTA1) < MACHTOL "AND" ABS(DELTA2) < MACHTOL "THEN" "BEGIN" TF1[I]:= MV1 / MACHTOL; TF2[I]:= MV2 / MACHTOL "END" "ELSE" COMDIV(MV1, MV2, DELTA1, DELTA2, TF1[I], TF2[I]); "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" M "DO" COMMATVEC(1, J, I, VEC1, VEC2, TF1, TF2, VEC1[I,J], VEC2[I,J]); "END"; OUT: EM[3]:= R; EM[5]:= COUNT; QRICOM:= N; "END" QRICOM; "COMMENT" ================== 34374 =================; "INTEGER" "PROCEDURE" EIGVALCOM(AR, AI, N, EM, VALR, VALI); "VALUE" N; "INTEGER" N; "ARRAY" AR, AI, EM, VALR, VALI; "BEGIN" "INTEGER" "ARRAY" INT[1:N]; "ARRAY" D, B, DEL, TR, TI[1:N]; "PROCEDURE" HSHCOMHES(AR,AI,N,EM,B,TR,TI,DEL);"CODE" 34366; "REAL" "PROCEDURE" COMEUCNRM(AR,AI,LW,N);"CODE" 34359; "PROCEDURE" EQILBRCOM(A1,A2,N,EM,D,INT);"CODE" 34361; "INTEGER" "PROCEDURE" VALQRICOM(A1,A2,B,N,EM,VAL1,VAL2); "CODE" 34372; EQILBRCOM(AR, AI, N, EM, D, INT); EM[1]:= COMEUCNRM(AR, AI, N - 1, N); HSHCOMHES(AR, AI, N, EM, B, TR, TI, DEL); EIGVALCOM:= VALQRICOM(AR, AI, B, N, EM, VALR, VALI) "END" EIGVALCOM; "COMMENT" ================== 34375 =================; "INTEGER" "PROCEDURE" EIGCOM(AR, AI, N, EM, VALR, VALI, VR, VI); "VALUE" N; "INTEGER" N; "ARRAY" AR, AI, EM, VALR, VALI, VR, VI; "BEGIN" "INTEGER" I; "INTEGER" "ARRAY" INT[1:N]; "ARRAY" D, B, DEL, TR, TI[1:N]; "PROCEDURE" EQILBRCOM(A1,A2,N,EM,D,INT);"CODE" 34361; "REAL" "PROCEDURE" COMEUCNRM(AR,AI,LW,N);"CODE" 34359; "PROCEDURE" HSHCOMHES(AR,AI,N,EM,B,TR,TI,DEL);"CODE" 34366; "INTEGER" "PROCEDURE" QRICOM(A1,A2,B,N,EM,VAL1,VAL2,VEC1,VEC2); "CODE" 34373; "PROCEDURE" BAKCOMHES(AR,AI,TR,TI,DEL,VR,VI,N,N1,N2); "CODE" 34367; "PROCEDURE" BAKLBRCOM(N,N1,N2,D,INT,VR,VI);"CODE" 34362; "PROCEDURE" SCLCOM(AR,AI,N,N1,N2);"CODE" 34360; EQILBRCOM(AR, AI, N, EM, D, INT); EM[1]:= COMEUCNRM(AR, AI, N - 1, N); HSHCOMHES(AR, AI, N, EM, B, TR, TI, DEL); I:= EIGCOM:= QRICOM(AR, AI, B, N, EM, VALR, VALI, VR, VI); "IF" I = 0 "THEN" "BEGIN" BAKCOMHES(AR, AI, TR, TI, DEL, VR, VI, N, 1, N); BAKLBRCOM(N, 1, N, D, INT, VR, VI); SCLCOM(VR, VI, N, 1, N) "END" "END" EIGCOM; "COMMENT" ================== 34270 =================; "INTEGER" "PROCEDURE" QRISNGVALBID(D, B, N, EM); "VALUE" N; "INTEGER" N; "ARRAY" D, B, EM; "BEGIN" "INTEGER" N1, K, K1, I, I1, COUNT, MAX, RNK; "REAL" TOL, BMAX, Z, X, Y, G, H, F, C, S, MIN; TOL:= EM[2] * EM[1]; COUNT:= 0; BMAX:= 0; MAX:= EM[4]; MIN:= EM[6]; RNK:= N; IN: K:= N; N1:= N - 1; NEXT: K:= K - 1; "IF" K > 0 "THEN" "BEGIN" "IF" ABS(B[K]) >= TOL "THEN" "BEGIN" "IF" ABS(D[K]) >= TOL "THEN" "GOTO" NEXT; C:= 0; S:= 1; "FOR" I:= K "STEP" 1 "UNTIL" N1 "DO" "BEGIN" F:= S * B[I]; B[I]:= C * B[I]; I1:= I + 1; "IF" ABS(F) < TOL "THEN" "GOTO" NEGLECT; G:= D[I1]; D[I1]:= H:= SQRT(F * F + G * G); C:= G / H; S:= - F / H "END"; NEGLECT: "END" "ELSE" "IF" ABS(B[K]) > BMAX "THEN" BMAX:= ABS(B[K]) "END"; "IF" K = N1 "THEN" "BEGIN" "IF" D[N] < 0 "THEN" D[N]:= - D[N]; "IF" D[N] <= MIN "THEN" RNK:= RNK - 1; N:= N1 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" END; K1:= K + 1; Z:= D[N]; X:= D[K1]; Y:= D[N1]; G:= "IF" N1 = 1 "THEN" 0 "ELSE" B[N1 - 1]; H:= B[N1]; F:= ((Y - Z) * (Y + Z) + (G - H) * (G + H)) / (2 * H * Y); G:= SQRT(F * F + 1); F:= ((X - Z) * (X + Z) + H * (Y / ("IF" F < 0 "THEN" F - G "ELSE" F + G) - H)) / X; C:= S:= 1; "FOR" I:= K1 + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" I1:= I - 1; G:= B[I1]; Y:= D[I]; H:= S * G; G:= C * G; Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z; "IF" I1 ^= K1 "THEN" B[I1 - 1]:= Z; F:= X * C + G * S; G:= G * C - X * S; H:= Y * S; Y:= Y * C; D[I1]:= Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z; F:= C * G + S * Y; X:= C * Y - S * G "END"; B[N1]:= F; D[N]:= X "END"; "IF" N > 0 "THEN" "GOTO" IN; END: EM[3]:= BMAX; EM[5]:= COUNT; EM[7]:= RNK; QRISNGVALBID:= N "END" QRISNGVALBID; "COMMENT" ================== 34271 =================; "INTEGER" "PROCEDURE" QRISNGVALDECBID(D, B, M, N, U, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" D, B, U, V, EM; "BEGIN" "INTEGER" N0, N1, K, K1, I, I1, COUNT, MAX, RNK; "REAL" TOL, BMAX, Z, X, Y, G, H, F, C, S, MIN; "PROCEDURE" ROTCOL(L, U, I, J, A, C, S); "VALUE" L, U, I, J, C, S; "INTEGER" L, U, I, J; "REAL" C, S; "ARRAY" A; "CODE" 34040; TOL:= EM[2] * EM[1]; COUNT:= 0; BMAX:= 0; MAX:= EM[4]; MIN:= EM[6]; RNK:= N0:= N; IN: K:= N; N1:= N - 1; NEXT: K:= K - 1; "IF" K > 0 "THEN" "BEGIN" "IF" ABS(B[K]) >= TOL "THEN" "BEGIN" "IF" ABS(D[K]) >= TOL "THEN" "GOTO" NEXT; C:= 0; S:= 1; "FOR" I:= K "STEP" 1 "UNTIL" N1 "DO" "BEGIN" F:= S * B[I]; B[I]:= C * B[I]; I1:= I + 1; "IF" ABS(F) < TOL "THEN" "GOTO" NEGLECT; G:= D[I1]; D[I1]:= H:= SQRT(F * F + G * G); C:= G / H; S:= - F / H; ROTCOL(1, M, K, I1, U, C, S) "END"; NEGLECT: "END" "ELSE" "IF" ABS(B[K]) > BMAX "THEN" BMAX:= ABS(B[K]) "END"; "IF" K = N1 "THEN" "BEGIN" "IF" D[N] < 0 "THEN" "BEGIN" D[N]:= - D[N]; "FOR" I:= 1 "STEP" 1 "UNTIL" N0 "DO" V[I,N]:= - V[I,N] "END"; "IF" D[N] <= MIN "THEN" RNK:= RNK - 1; N:= N1 "END" "ELSE" "BEGIN" COUNT:= COUNT + 1; "IF" COUNT > MAX "THEN" "GOTO" END; K1:= K + 1; Z:= D[N]; X:= D[K1]; Y:= D[N1]; G:= "IF" N1 = 1 "THEN" 0 "ELSE" B[N1 - 1]; H:= B[N1]; F:= ((Y - Z) * (Y + Z) + (G - H) * (G + H)) / (2 * H * Y); G:= SQRT(F * F + 1); F:= ((X - Z) * (X + Z) + H * (Y / ("IF" F < 0 "THEN" F - G "ELSE" F + G) - H)) / X; C:= S:= 1; "FOR" I:= K1 + 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" I1:= I - 1; G:= B[I1]; Y:= D[I]; H:= S * G; G:= C * G; Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z; "IF" I1 ^= K1 "THEN" B[I1 - 1]:= Z; F:= X * C + G * S; G:= G * C - X * S; H:= Y * S; Y:= Y * C; ROTCOL(1, N0, I1, I, V, C, S); D[I1]:= Z:= SQRT(F * F + H * H); C:= F / Z; S:= H / Z; F:= C * G + S * Y; X:= C * Y - S * G; ROTCOL(1, M, I1, I, U, C, S) "END"; B[N1]:= F; D[N]:= X "END"; "IF" N > 0 "THEN" "GOTO" IN; END: EM[3]:= BMAX; EM[5]:= COUNT; EM[7]:= RNK; QRISNGVALDECBID:= N "END" QRISNGVALDECBID; "COMMENT" ================== 34272 =================; "INTEGER" "PROCEDURE" QRISNGVAL(A, M, N, VAL, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, EM; "BEGIN" "ARRAY" B[1:N]; "PROCEDURE" HSHREABID(A, M, N, D, B, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" D, B, EM; "CODE" 34260; "INTEGER" "PROCEDURE" QRISNGVALBID(D, B, N, EM); "VALUE" N; "INTEGER" N; "ARRAY" D, B, EM; "CODE" 34270; HSHREABID(A, M, N, VAL, B, EM); QRISNGVAL:= QRISNGVALBID(VAL, B, N, EM) "END" QRISNGVAL; "COMMENT" ================== 34273 =================; "INTEGER" "PROCEDURE" QRISNGVALDEC(A, M, N, VAL, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, VAL, V, EM; "BEGIN" "ARRAY" B[1:N]; "PROCEDURE" HSHREABID(A, M, N, D, B, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, D, B, EM; "CODE" 34260; "PROCEDURE" PSTTFMMAT(A, N, V, B); "VALUE" N; "INTEGER" N; "ARRAY" A, V, B; "CODE" 34261; "PROCEDURE" PRETFMMAT(A, M, N, D); "VALUE" M, N; "INTEGER" M, N; "ARRAY" A, D; "CODE" 34262; "INTEGER" "PROCEDURE" QRISNGVALDECBID(D, B, M, N, U, V, EM); "VALUE" M, N; "INTEGER" M, N; "ARRAY" D, B, U, V, EM; "CODE" 34271; HSHREABID(A, M, N, VAL, B, EM); PSTTFMMAT(A, N, V, B); PRETFMMAT(A, M, N, VAL); QRISNGVALDEC:= QRISNGVALDECBID(VAL, B, M, N, A, V, EM) "END" QRISNGVALDEC; "COMMENT" ================== 34345 =================; "PROCEDURE" COMKWD(PR,PI,QR,QI,GR,GI,KR,KI); "VALUE" PR,PI,QR,QI;"REAL" PR,PI,QR,QI,GR,GI,KR,KI; "BEGIN" "PROCEDURE"COMMUL (AR,AI,BR,BI,RR,RI); "CODE" 34341; "PROCEDURE"COMDIV(XR,XI,YR,YI,ZR,ZI); "CODE" 34342; "PROCEDURE"COMSQRT(AR,AI,PR,PI); "CODE" 34343; "IF" QR=0 & QI = 0 "THEN" "BEGIN" KR:=KI:=0 ;GR:=PR*2;GI:=PI*2 "END" "ELSE" "IF" PR=0 & PI= 0 "THEN" "BEGIN" COMSQRT(QR,QI,GR,GI);KR:=-GR;KI:=-GI "END" "ELSE" "BEGIN" "REAL" HR,HI; "IF" ABS(PR) > 1 "OR" ABS(PI) >1 "THEN" "BEGIN" COMDIV(QR,QI,PR,PI,HR,HI); COMDIV(HR,HI,PR,PI,HR,HI); COMSQRT(1+HR,HI,HR,HI); COMMUL(PR,PI,HR+1,HI,GR,GI); "END" "ELSE" "BEGIN" COMSQRT(QR+(PR+PI)*(PR-PI),QI+ PR*PI*2,HR,HI); "IF" PR * HR + PI * HI > 0 "THEN" "BEGIN" GR := PR + HR;GI := PI + HI "END" "ELSE" "BEGIN" GR := PR - HR;GI:= PI - HI "END"; "END"; COMDIV(-QR,-QI,GR,GI,KR,KI); "END" "END" COMKWD; "COMMENT" ================== 32010 =================; "REAL""PROCEDURE" EULER(AI, I, EPS, TIM); "VALUE" EPS, TIM; "INTEGER" I, TIM; "REAL" AI, EPS; "BEGIN""INTEGER" K, N, T; "REAL" MN, MP, DS, SUM; "ARRAY" M[0:15]; N:= T:= 0; I:= 0; M[0]:= AI; SUM:= M[0] / 2; NEXT TERM: I:= I + 1; MN:= AI; "FOR" K:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" MP:= (MN + M[K]) / 2; M[K]:= MN; MN:= MP "END"; "IF" ABS(MN) < ABS(M[N]) & N < 15 "THEN" "BEGIN" DS:= MN / 2; N:= N + 1; M[N]:= MN "END" "ELSE" DS:= MN; SUM:= SUM + DS; T:= "IF" ABS(DS) < EPS "THEN" T + 1 "ELSE" 0; "IF" T < TIM "THEN" "GO TO" NEXT TERM; EULER:= SUM "END" EULER; "COMMENT" ================== 32020 =================; "REAL" "PROCEDURE" SUMPOSSERIES(AI, I, MAXADDUP, MAXZERO,MAXRECURS, MACHEXP, TIM); "VALUE" MAXADDUP, MAXZERO, MAXRECURS, MACHEXP, TIM; "REAL" AI, I, MAXZERO; "INTEGER" MAXADDUP, MAXRECURS, MACHEXP, TIM; "BEGIN" "INTEGER" RECURS, VL, VL2, VL4; "REAL" "PROCEDURE" EULER(AI, I, EPS, TIM); "CODE" 32010; "REAL" "PROCEDURE" SUMUP(AI, I); "REAL" AI, I; "BEGIN" "INTEGER" J; "REAL" SUM, NEXTTERM; I:= MAXADDUP + 1; J:= 1; CHECK ADD: "IF" AI <= MAXZERO "THEN" "BEGIN""IF" J < TIM "THEN" "BEGIN" J:= J + 1; I:= I + 1; "GO TO" CHECK ADD "END" "END""ELSE" "IF" RECURS ^= MAXRECURS "THEN""GO TO" TRANSFORMSERIES; SUM:= 0; I:= 0; J:= 0; ADD LOOP: I:= I + 1; NEXTTERM:= AI; J:= "IF" NEXTTERM <= MAXZERO "THEN" J + 1 "ELSE" 0; SUM:= SUM + NEXTTERM; "IF" J < TIM "THEN""GO TO" ADD LOOP; SUMUP:= SUM; "GO TO" GOTSUM; TRANSFORMSERIES: "BEGIN""BOOLEAN" JODD; "INTEGER" J2; "ARRAY" V[1:VL]; "REAL""PROCEDURE" BJK(J, K); "VALUE" J, K; "REAL" K; "INTEGER" J; "BEGIN""REAL" COEFF; "IF" K > MACHEXP "THEN" BJK:= 0 "ELSE" "BEGIN" COEFF:= 2 ** (K - 1); I:= J * COEFF; BJK:= COEFF * AI "END" "END" BJK; "REAL""PROCEDURE" VJ(J); "VALUE" J; "INTEGER" J; "BEGIN""REAL" TEMP, K; "IF" JODD "THEN" "BEGIN" JODD:= "FALSE"; RECURS:= RECURS + 1; TEMP:= VJ:= SUMUP(BJK(J, K), K); RECURS:= RECURS - 1; "IF" J <= VL "THEN" V[J]:= TEMP "ELSE" "IF" J <= VL2 "THEN" V[J - VL]:= TEMP "END""ELSE" "BEGIN" JODD:= "TRUE"; "IF" J > VL4 "THEN" "BEGIN" RECURS:= RECURS + 1; VJ:= - SUMUP(BJK(J, K), K); RECURS:= RECURS - 1 "END""ELSE" "BEGIN" J2:= J2 + 1; I:= J2; "IF" J > VL2 "THEN" VJ:= - (V[J2 - VL] - AI) / 2 "ELSE" "BEGIN" TEMP:= V["IF" J <= VL "THEN" J "ELSE" J - VL]:= (V[J2] - AI) / 2; VJ:= - TEMP "END" "END" "END" "END" VJ; J2:= 0; JODD:= "TRUE"; SUMUP:= EULER(VJ(J + 1), J, MAXZERO, TIM) "END" TRANSFORMSERIES; GOTSUM: "END" SUMUP; RECURS:= 0; VL:= 1000; VL2:= 2 * VL; VL4:= 2 * VL2; SUMPOSSERIES:= SUMUP(AI, I) "END" SUMPOSSERIES; "COMMENT" ================== 32070 =================; "REAL" "PROCEDURE" QADRAT(X, A, B, FX, E); "VALUE" A, B; "REAL" X, A, B, FX; "ARRAY" E; "BEGIN" "REAL" F0, F2, F3, F5, F6, F7, F9, F14, V, W, HMIN, HMAX, RE, AE; "REAL" "PROCEDURE" LINT(X0, XN, F0, F2, F3, F5, F6, F7, F9, F14); "REAL" X0, XN, F0, F2, F3, F5, F6, F7, F9, F14; "BEGIN" "REAL" H, XM, F1, F4, F8, F10, F11, F12, F13; XM:= (X0 + XN) / 2; H:= (XN - X0) / 32; X:= XM + 4 * H; F8:= FX; X:= XN - 4 * H; F11:= FX; X:= XN - 2 * H; F12:= FX; V:= 0.330580178199226 * F7 + 0.173485115707338 * (F6 + F8) + 0.321105426559972*(F5 + F9) + 0.135007708341042 * (F3 + F11) + 0.165714514228223*(F2 + F12) + 0.393971460638127"- 1 * (F0 + F14); X:= X0 + H; F1:= FX; X:= XN - H; F13:= FX; W:= 0.260652434656970 * F7 + 0.239063286684765 * (F6 + F8) + 0.263062635477467*(F5 + F9) + 0.218681931383057 * (F3 + F11) + 0.275789764664284"- 1 * (F2 + F12) + 0.105575010053846* (F1 + F13) + 0.157119426059518"- 1 * (F0 + F14); "IF" ABS(H) < HMIN "THEN" E[3]:= E[3] + 1; "IF" ABS(V - W) < ABS(W) * RE + AE "OR" ABS(H) < HMIN "THEN" LINT:= H * W "ELSE" "BEGIN" X:= X0 + 6 * H; F4:= FX; X:= XN - 6 * H; F10:= FX; V:= 0.245673430093324* F7 + 0.255786258286921* (F6 + F8) + 0.228526063690406*(F5 + F9) + 0.500557131525460"- 1*(F4 + F10) + 0.177946487736780*(F3 + F11)+0.584014599347449"- 1 * (F2 + F12) + 0.874830942871331"- 1 * (F1 + F13) + 0.189642078648079"- 1 * (F0 + F14); LINT:= "IF" ABS(V - W) < ABS(V) * RE + AE "THEN" H * V "ELSE" LINT(X0, XM, F0, F1, F2, F3, F4, F5, F6, F7) - LINT(XN, XM, F14, F13, F12, F11, F10, F9, F8, F7) "END" "END" LINT; HMAX:= (B - A) / 16; "IF" HMAX=0 "THEN" "BEGIN" QADRAT:= 0; "GOTO" RETURN "END"; RE:= E[1]; AE:= 2 * E[2] / ABS(B - A); E[3]:= 0; HMIN:= ABS(B - A) * RE; X:= A; F0:= FX; X:= A + HMAX; F2:= FX; X:= A + 2 * HMAX; F3:= FX; X:= A + 4 * HMAX; F5:= FX; X:= A + 6 * HMAX; F6:= FX; X:= A + 8 * HMAX; F7:= FX; X:= B - 4 * HMAX; F9:= FX; X:= B; F14:= FX; QADRAT:= LINT(A, B, F0, F2, F3, F5, F6, F7, F9, F14) * 16; RETURN: "END" QADRAT; "COMMENT" ================== 32051 =================; "REAL" "PROCEDURE" INTEGRAL(X, A, B, FX, E, UA, UB); "VALUE" A,B;"REAL" X, A, B, FX; "ARRAY" E; "BOOLEAN" UA, UB; "BEGIN" "REAL" "PROCEDURE" TRANSF; "BEGIN" Z:= 1 / X; X:= Z + B1; TRANSF:= FX * Z * Z "END"; "REAL" "PROCEDURE" QAD(FX); "REAL" FX; "BEGIN" "REAL" T, V, SUM, HMIN; "PROCEDURE" INT; "BEGIN" "REAL" X3, X4, F3, F4, H; X4:= X2; X2:= X1; F4:= F2; F2:= F1; ANEW: X:= X1:= (X0 + X2) * .5; F1:= FX; X:= X3:= (X2 + X4) * .5; F3:= FX; H:= X4 - X0; V:= (4 * (F1 + F3) +2 * F2 + F0 + F4) * 15; T:= 6 * F2 -4 * (F1 + F3) + F0 + F4; "IF" ABS(T) < ABS(V) * RE + AE "THEN" SUM:=SUM + (V - T) * H "ELSE" "IF" ABS(H) < HMIN "THEN" E[3]:= E[3] +1 "ELSE" "BEGIN" INT; X2:= X3; F2:= F3; "GOTO" ANEW "END"; X0:= X4; F0:= F4 "END" INT; HMIN:= ABS(X0 - X2) * RE; X:= X1:= (X0 + X2) * .5; F1:=FX;SUM:= 0; INT; QAD:= SUM / 180 "END" QAD; "REAL" X0, X1, X2, F0, F1, F2, RE, AE, B1, Z; RE:= E[1]; "IF" UB "THEN" AE:= E[2] * 180 / ABS(B - A) "ELSE" AE:= E[2] * 90 / ABS(B - A); "IF" UA "THEN" "BEGIN" E[3]:= E[4]:= 0; X:= X0:= A; F0:= FX "END" "ELSE" "BEGIN" X:= X0:= A:= E[5]; F0:= E[6] "END"; E[5]:= X:= X2:= B; E[6]:= F2:= FX; E[4]:= E[4] + QAD(FX); "IF" ^UB "THEN" "BEGIN" "IF" A < B "THEN" "BEGIN" B1:= B -1 ; X0:= 1 "END" "ELSE" "BEGIN" B1:= B +1 ; X0:= -1 "END"; F0:= E[6]; E[5]:= X2:= 0; E[6]:= F2:= 0; AE:= E[2] * 90; E[4]:= E[4] - QAD(TRANSF) "END"; INTEGRAL:= E[4] "END" INTEGRAL; "COMMENT" ================== 34210 =================; "PROCEDURE" LINEMIN(N, X, D, ND, ALFA, G, FUNCT, F0, F1, DF0, DF1, EVLMAX, STRONGSEARCH, IN); "VALUE" N, ND, F0, DF0, STRONGSEARCH; "INTEGER" N, EVLMAX; "BOOLEAN" STRONGSEARCH; "REAL" ND, ALFA, F0, F1, DF0, DF1; "ARRAY" X, D, G, IN; "REAL" "PROCEDURE" FUNCT; "BEGIN" "INTEGER" I, EVL; "BOOLEAN" NOTININT; "REAL" F,OLDF,DF,OLDDF,MU,ALFA0,Q,W,Y,Z,RELTOL,ABSTOL ,EPS, AID; "ARRAY" X0[1:N]; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; "PROCEDURE" DUPVEC(L, U, SHIFT, A, B); "CODE" 31030; RELTOL:= IN[1]; ABSTOL:= IN[2]; MU:= IN[3]; EVL:= 0; ALFA0:= 0; OLDF:= F0; OLDDF:= DF0; Y:= ALFA; NOTININT:= "TRUE"; DUPVEC(1, N, 0, X0, X); EPS:= (SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL) / ND; Q:= (F1 - F0) / (ALFA * DF0); INT: "IF" NOTININT "THEN" NOTININT:= DF1 < 0 "AND" Q > MU; AID:= ALFA; "IF" DF1 >= 0 "THEN" "BEGIN" Z:= 3 * (OLDF - F1) / ALFA + OLDDF + DF1; W:= SQRT(Z ** 2 - OLDDF * DF1); ALFA:= ALFA * (1 - (DF1 + W - Z) / (DF1 - OLDDF + W * 2)); "IF" ALFA < EPS "THEN" ALFA:= EPS "ELSE" "IF" AID - ALFA < EPS "THEN" ALFA:= AID - EPS "END" CUBIC INTERPOLATION "ELSE" "IF" NOTININT "THEN" "BEGIN" ALFA0:= ALFA:= Y; OLDDF:= DF1; OLDF:= F1 "END" "ELSE" ALFA:= 0.5 * ALFA; Y:= ALFA + ALFA0; DUPVEC(1, N, 0, X, X0); ELMVEC(1, N, 0, X, D, Y); EPS:= (SQRT(VECVEC(1, N, 0, X, X)) * RELTOL + ABSTOL) / ND; F:= FUNCT(N, X, G); EVL:= EVL +1 ; DF:= VECVEC(1, N, 0, D, G); Q:= (F - F0) / (Y * DF0); "IF" ("IF" NOTININT "OR" STRONGSEARCH "THEN" "TRUE" "ELSE" Q < MU "OR" Q > 1 - MU) "AND" EVL < EVLMAX "THEN" "BEGIN" "IF" NOTININT "OR" DF > 0 "OR" Q < MU "THEN" "BEGIN" DF1:= DF; F1:= F "END" "ELSE" "BEGIN" ALFA0:= Y; ALFA:= AID - ALFA; OLDDF:= DF; OLDF:= F "END"; "IF" ALFA > EPS * 2 "THEN" "GOTO" INT "END"; ALFA:= Y; EVLMAX:= EVL; DF1:= DF; F1:= F "END" LINEMIN; "COMMENT" ================== 34211 =================; "PROCEDURE" RNK1UPD(H, N, V, C);"VALUE" N, C; "INTEGER" N; "REAL" C;"ARRAY" H, V; "BEGIN" "INTEGER" J, K; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; K:= 0; "FOR" J:= 1, J + K "WHILE" K < N "DO" "BEGIN" K:= K +1 ; ELMVEC(J, J + K - 1, 1 - J, H, V, V[K] * C) "END" "END" RNK1UPD; "COMMENT" ================== 34212 =================; "PROCEDURE" DAVUPD(H, N, V, W, C1, C2); "VALUE" N, C1, C2; "INTEGER" N; "REAL" C1, C2; "ARRAY" H, V, W; "BEGIN" "INTEGER" I, J, K; "REAL" VK, WK; K:= 0; "FOR" J:= 1, J + K "WHILE" K < N "DO" "BEGIN" K:= K +1 ; VK:= V[K] * C1; WK:= W[K] * C2; "FOR" I:= 0 "STEP" 1 "UNTIL" K -1 "DO" H[I + J]:= H[I + J] + V[I + 1] * VK - W[I + 1] * WK "END" "END" DAVUPD; "COMMENT" ================== 34213 =================; "PROCEDURE" FLEUPD(H, N, V, W, C1, C2); "VALUE" N, C1, C2; "INTEGER" N; "REAL" C1, C2; "ARRAY" H, V, W; "BEGIN" "INTEGER" I, J, K; "REAL" VK, WK; K:= 0; "FOR" J:= 1, J + K "WHILE" K < N "DO" "BEGIN" K:= K +1; VK:= - W[K] * C1 + V[K] * C2; WK:= V[K] * C1; "FOR" I:= 0 "STEP" 1 "UNTIL" K - 1 "DO" H[I + J]:= H[I + J] + V[I + 1] * VK -W[I + 1] * WK "END" "END" FLEUPD; "COMMENT" ================== 33010 =================; "PROCEDURE" RK1(X, A, B, Y, YA, FXY, E, D, FI); "VALUE" B, FI; "REAL" X, A, B, Y, YA, FXY; "BOOLEAN" FI; "ARRAY" E, D; "BEGIN" "REAL" E1, E2, XL, YL, H, INT, HMIN, ABSH, K0, K1, K2, K3, K4, K5, DISCR, TOL, MU, MU1, FH, HL; "BOOLEAN" LAST, FIRST, REJECT; "IF" FI "THEN" "BEGIN" D[3]:= A; D[4]:= YA "END"; D[1]:= 0; XL:= D[3]; YL:= D[4]; "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]); "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL); HMIN:= INT * E[1] + E[2]; E1:= E[1] / INT; E2:= E[2] / INT; FIRST:= "TRUE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN "END"; "IF" H >= B - XL "EQUIV" H >= 0 "THEN" "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: X:= XL; Y:= YL; K0:= FXY * H; X:= XL + H / 4.5; Y:= YL + K0 / 4.5; K1:= FXY * H; X:= XL + H / 3; Y:= YL + (K0 + K1 * 3) / 12; K2:= FXY * H; X:= XL + H * .5; Y:= YL + (K0 + K2 * 3) / 8; K3:= FXY * H; X:= XL + H * .8; Y:= YL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56) / 125; K4:= FXY * H; X:= "IF" LAST "THEN" B "ELSE" XL + H; Y:= YL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112 + K4 * 25) / 168; K5:= FXY * H; DISCR:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 * 125 + K5 * 42) / 14; TOL:= ABS(K0) * E1 + ABSH * E2; REJECT:= DISCR > TOL; MU:= TOL / (TOL + DISCR) + .45; "IF" REJECT "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" D[1]:= D[1] + 1; Y:= YL; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FH:= MU * H / HL + MU - MU1; HL:= H; H:= FH * H; ACC: MU1:= MU; Y:= YL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112 + K4 * 50) / 28; K5:= FXY * HL; Y:= YL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14) / 336; NEXT: "IF" B ^= X "THEN" "BEGIN" XL:= X; YL:= Y; "GOTO" TEST "END"; "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; D[4]:= Y "END" RK1; "COMMENT" ================== 33033 =================; "PROCEDURE" RKE (X, XE, N, Y, DER, DATA, FI, OUT); "VALUE" FI, N; "INTEGER" N; "REAL" X, XE; "BOOLEAN" FI; "ARRAY" Y, DATA; "PROCEDURE" DER, OUT; "BEGIN" "INTEGER" J; "REAL" XT, H, HMIN, INT, HL, HT, ABSH, FHM, DISCR, TOL, MU, MU1, FH, E1, E2; "BOOLEAN" LAST, FIRST, REJECT; "ARRAY" K0, K1, K2, K3, K4[1:N]; "IF" FI "THEN" "BEGIN" DATA[3]:= XE - X; DATA[4]:= DATA[5]:= DATA[6]:= 0 "END"; ABSH:= H:= ABS(DATA[3]); "IF" XE < X "THEN" H:= - H; INT:= ABS(XE - X); HMIN:= INT * DATA[1] + DATA[2]; E1:= 12 * DATA[1] / INT; E2:= 12 * DATA[2] / INT; FIRST:= "TRUE"; REJECT:= "FALSE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= SIGN (XE - X) * HMIN; ABSH:= HMIN "END"; "IF" H >= XE - X "EQUIV" H >= 0 "THEN" "BEGIN" LAST:= "TRUE"; H:= XE - X; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: "IF" ^ REJECT "THEN" "BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K0[J]:= Y[J]; DER(X, K0) "END"; HT:= .184262134833347 * H; XT:= X + HT; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= K0[J] * HT + Y[J]; DER(XT, K1); HT:= .690983005625053"-1 * H; XT:= 4 * HT + X; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K2[J]:= (3 * K1[J] + K0[J]) * HT + Y[J]; DER(XT, K2); XT:= .5 * H + X; HT:= .1875 * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K3[J]:=((1.74535599249993 * K2[J] - K1[J]) * 2.23606797749979 + K0[J]) * HT + Y[J]; DER(XT, K3); XT:= .723606797749979 * H + X; HT:= .4 * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K4[J]:= (((.517595468166681 * K0[J] - K1[J]) * .927050983124840 + K2[J]) * 1.46352549156242 + K3[J]) * HT + Y[J]; DER(XT, K4); XT:= "IF" LAST "THEN" XE "ELSE" X + H; HT:= 2 * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= ((((2 * K4[J] + K2[J]) * .412022659166595 + K1[J]) * 2.23606797749979 - K0[J]) * .375 - K3[J]) * HT + Y[J]; DER(XT, K1); REJECT:= "FALSE"; FHM:= 0; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DISCR:= ABS((1.6 * K3[J] - K2[J] - K4[J]) * 5 + K0[J] + K1[J]); TOL:= ABS(K0[J]) * E1 + E2; REJECT:= DISCR > TOL "OR" REJECT; FH:= DISCR / TOL; "IF" FH > FHM "THEN" FHM:= FH "END"; MU:= 1 / (1 + FHM) + .45; "IF" REJECT "THEN" "BEGIN" DATA[5]:= DATA[5] + 1; "IF" ABSH <= HMIN "THEN" "BEGIN" DATA[6]:= DATA[6] + 1; HL:= H; REJECT:= "FALSE"; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FH:= MU * H / HL + MU - MU1; HL:= H; H:= FH * H; ACC: MU1:= MU; HT:= HL / 12; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" Y[J]:= ((K2[J] + K4[J]) * 5 + K0[J] + K1[J]) * HT + Y[J]; NEXT: DATA[3]:= HL; DATA[4]:= DATA[4] + 1; X:= XT; OUT; "IF" X ^= XE "THEN" "GOTO" TEST "END" RKE; "COMMENT" ================== 33016 =================; "PROCEDURE" RK4A(X, XA, B, Y, YA, FXY, E, D, FI, XDIR, POS); "VALUE" FI, XDIR, POS; "BOOLEAN" FI, XDIR, POS; "REAL" X, XA, B, Y, YA, FXY; "ARRAY" E, D; "BEGIN" "INTEGER" I; "BOOLEAN" IV, FIRST, FIR, REJ; "REAL" K0, K1, K2, K3, K4, K5, FHM, ABSH, DISCR, S, XL, COND0, S1, COND1, YL, HMIN, H, ZL, TOL, HL, MU, MU1; "ARRAY" E1[1:2]; "BOOLEAN" "PROCEDURE" ZEROIN(X,Y,FX,EPS) ; "REAL" X,Y,FX,EPS ; "CODE" 34150 ; "PROCEDURE" RKSTEP(X, XL, H, Y, YL, ZL, FXY, D); "VALUE" XL, YL, ZL, H; "REAL" X, XL, H, Y, YL, ZL, FXY; "INTEGER" D; "BEGIN" "IF" D = 2 "THEN" "GOTO" INTEGRATE; "IF" D = 3 "THEN" "BEGIN" X:= XL; Y:= YL; K0:= FXY * H "END" "ELSE" "IF" D = 1 "THEN" K0:= ZL * H "ELSE" K0:= K0 * MU; X:= XL + H / 4.5; Y:= YL + K0 / 4.5; K1:= FXY * H; X:= XL + H / 3; Y:= YL + (K0 + K1 * 3) / 12; K2:= FXY * H; X:= XL + H * .5; Y:= YL + (K0 + K2 * 3) / 8; K3:= H * FXY; X:= XL + H * .8; Y:= YL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56) / 125; K4:= FXY * H; "IF" D <= 1 "THEN" "BEGIN" X:= XL + H; Y:= YL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112 + K4 * 25) / 168; K5:= FXY * H; DISCR:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 * 125 + K5 * 42) / 14; "GOTO" END "END"; INTEGRATE: X:= XL + H; Y:= YL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112 + K4 * 50) / 28; K5:= FXY * H; Y:= YL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14) / 336; END: "END" RKSTEP; "REAL" "PROCEDURE" FZERO; "BEGIN" "IF" IV "THEN" "BEGIN" "IF" S = XL "THEN" FZERO:= COND0 "ELSE" "IF" S = S1 "THEN" FZERO:= COND1 "ELSE" "BEGIN" RKSTEP(X, XL, S - XL, Y, YL, ZL, FXY, 3); FZERO:= B "END" "END" "ELSE" "BEGIN" "IF" S = YL "THEN" FZERO:= COND0 "ELSE" "IF" S = S1 "THEN" FZERO:= COND1 "ELSE" "BEGIN" RKSTEP(Y, YL, S - YL, X, XL, ZL, 1 / FXY, 3); FZERO:= B "END" "END" "END" FZERO; "IF" FI "THEN" "BEGIN" D[3]:= XA; D[4]:= YA; D[0]:= 1 "END"; D[1]:= 0; X:= XL:= D[3]; Y:= YL:= D[4]; IV:= D[0] > 0; FIRST:= FIR:= "TRUE"; HMIN:= E[0] + E[1]; H:= E[2] + E[3]; "IF" H < HMIN "THEN" HMIN:= H; CHANGE: ZL:= FXY; "IF" ABS(ZL) <= 1 "THEN" "BEGIN" "IF" "NOT"IV "THEN" "BEGIN" D[2]:= H:= H / ZL; D[0]:= 1; IV:= FIRST:= "TRUE" "END"; "IF" FIR "THEN" "GOTO" A; I:= 1; "GOTO" AGAIN "END" "ELSE" "BEGIN" "IF" IV "THEN" "BEGIN" "IF" "NOT"FIR "THEN" D[2]:= H:= H * ZL; D[0]:= - 1; IV:= "FALSE"; FIRST:= "TRUE" "END"; "IF" FIR "THEN" "BEGIN" H:= E[0] + E[1]; A: "IF" ("IF" FI "THEN" ("IF" IV "EQUIV" XDIR "THEN" H "ELSE" H * ZL) < 0 "EQUIV" POS "ELSE" H * D[2] < 0) "THEN" H:= - H "END"; I:= 1 "END"; AGAIN: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= SIGN(H) * HMIN; ABSH:= HMIN "END"; "IF" IV "THEN" "BEGIN" RKSTEP(X, XL, H, Y, YL, ZL, FXY, I); TOL:= E[2] * ABS(K0) + E[3] * ABSH "END" "ELSE" "BEGIN" RKSTEP(Y, YL, H, X, XL, 1 / ZL, 1 / FXY, I); TOL:= E[0] * ABS(K0) + E[1] * ABSH "END"; REJ:= DISCR > TOL; MU:= TOL / (TOL + DISCR) + .45; "IF" REJ "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" "IF" IV "THEN" "BEGIN" X:= XL + H; Y:= YL + K0 "END" "ELSE" "BEGIN" X:= XL + K0; Y:= YL + H "END"; D[1]:= D[1] + 1; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= H * MU; I:= 0; "GOTO" AGAIN "END" REJ; "IF" FIRST "THEN" "BEGIN" FIRST:= FIR; HL:= H; H:= MU * H; "GOTO" ACCEPT "END"; FHM:= MU * H / HL + MU - MU1; HL:= H; H:= FHM * H; ACCEPT: "IF" IV "THEN" RKSTEP(X, XL, HL, Y, YL, ZL, FXY, 2) "ELSE" RKSTEP(Y, YL, HL, X, XL, ZL, 1 / FXY, 2); MU1:= MU; NEXT: "IF" FIR "THEN" "BEGIN" FIR:= "FALSE"; COND0:= B; "IF" "NOT"(FI "OR" REJ) "THEN" H:= D[2] "END" "ELSE" "BEGIN" D[2]:= H; COND1:= B; "IF" COND0 * COND1 <= 0 "THEN" "GOTO" ZERO; COND0:= COND1 "END"; D[3]:= XL:= X; D[4]:= YL:= Y; "GOTO" CHANGE; ZERO: E1[1]:= E[4]; E1[2]:= E[5]; S1:= "IF" IV "THEN" X "ELSE" Y; S:= "IF" IV "THEN" XL "ELSE" YL ; ZEROIN(S,S1,FZERO,ABS(E1[1]*S)+ABS(E1[2])) ; S1:= "IF" IV "THEN" X "ELSE" Y ; "IF" IV "THEN" RKSTEP(X, XL, S - XL, Y, YL, ZL, FXY, 3) "ELSE" RKSTEP(Y, YL, S - YL, X, XL, ZL, 1 / FXY, 3); D[3]:= X; D[4]:= Y "END" RK4A; "COMMENT" ================== 33017 =================; "PROCEDURE" RK4NA(X, XA, B, FXJ, J, E, D, FI, N, L, POS); "VALUE" FI, N, L, POS; "INTEGER" J, N, L; "BOOLEAN" FI, POS; "REAL" B, FXJ; "ARRAY" X, XA, E, D; "BEGIN" "INTEGER" I, IV, IV0; "BOOLEAN" FIR, FIRST, REJ; "REAL" H, COND0, COND1, FHM, ABSH, TOL, FH, MAX, X0, X1, S, HMIN, HL, MU, MU1; "ARRAY" XL, DISCR, Y[0:N], K[0:5,0:N], E1[1:2]; "BOOLEAN" "PROCEDURE" ZEROIN(X,Y,FX,EPS) ; "REAL" X,Y,FX,EPS ; "CODE" 34150 ; "PROCEDURE" RKSTEP(H, D); "VALUE" H, D; "INTEGER" D; "REAL" H; "BEGIN" "INTEGER" I; "PROCEDURE" F(T); "VALUE" T; "INTEGER" T; "BEGIN" "INTEGER" I; "REAL" P; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" Y[J]:= FXJ; P:= H / Y[IV]; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" K[T,I]:= Y[I] * P "END" "END" F; "IF" D = 2 "THEN" "GOTO" INTEGRATE; "IF" D = 3 "THEN" "BEGIN" "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I]; F(0) "END" "ELSE" "IF" D = 1 "THEN" "BEGIN" "REAL" P; P:= H / Y[IV]; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" K[0,I]:= P * Y[I] "END" "END" "ELSE" "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" K[0,I]:= K[0,I] * MU "END"; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H "ELSE" K[0,I]) / 4.5; F(1); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H * 4 "ELSE" (K[0,I] + K[1,I] * 3)) / 12; F(2); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H * .5 "ELSE" (K[0,I] + K[2,I] * 3) / 8); F(3); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H * .8 "ELSE" (K[0,I] * 53 - K[1,I] * 135 + K[2,I] * 126 + K[3,I] * 56) / 125); F(4); "IF" D <= 1 "THEN" "BEGIN" "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H "ELSE" (K[0,I] * 133 - K[1,I] * 378 + K[2,I] * 276 + K[3,I] * 112 + K[4,I] * 25) / 168); F(5); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" DISCR[I]:= ABS(K[0,I] * 21 - K[2,I] * 162 + K[3,I] * 224 - K[4,I] * 125 + K[5,I] * 42) / 14 "END"; "GOTO" END "END"; INTEGRATE: "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I] + ("IF" I = IV "THEN" H "ELSE" ( - K[0,I] * 63 + K[1,I] * 189 - K[2,I] * 36 - K[3,I] * 112 + K[4,I] * 50) / 28); F(5); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" X[I]:= XL[I] + (K[0,I] * 35 + K[2,I] * 162 + K[4,I] * 125 + K[5,I] * 14) / 336 "END" ; END: "END" RKSTEP ; "REAL" "PROCEDURE" FZERO; "BEGIN" "IF" S = X0 "THEN" FZERO:= COND0 "ELSE" "IF" S = X1 "THEN" FZERO:= COND1 "ELSE" "BEGIN" RKSTEP(S - XL[IV], 3); FZERO:= B "END" "END" FZERO; "IF" FI "THEN" "BEGIN" "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" D[I + 3]:= XA[I]; D[0]:= D[2]:= 0 "END"; D[1]:= 0; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= XL[I]:= D[I + 3]; IV:= D[0]; H:= D[2]; FIRST:= FIR:= "TRUE"; Y[0]:= 1; "GOTO" CHANGE; AGAIN: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= ABS(H) "END"; RKSTEP(H, I); REJ:= "FALSE"; FHM:= 0; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" "BEGIN" TOL:= E[2 * I] * ABS(K[0,I]) + E[2 * I + 1] * ABSH; REJ:= TOL < DISCR[I] "OR" REJ; FH:= DISCR[I] / TOL; "IF" FH > FHM "THEN" FHM:= FH "END" "END"; MU:= 1 / (1 + FHM) + .45; "IF" REJ "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" I ^= IV "THEN" X[I]:= XL[I] + K[0,I] "ELSE" X[I]:= XL[I] + H "END"; D[1]:= D[1] + 1; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= H * MU; I:= 0; "GOTO" AGAIN "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= FIR; HL:= H; H:= MU * H; "GOTO" ACCEPT "END"; FH:= MU * H / HL + MU - MU1; HL:= H; H:= FH * H; ACCEPT: RKSTEP(HL, 2); MU1:= MU; NEXT: "IF" FIR "THEN" "BEGIN" FIR:= "FALSE"; COND0:= B; "IF" "NOT"(FI "OR" REJ) "THEN" H:= D[2] "END" "ELSE" "BEGIN" D[2]:= H; COND1:= B; "IF" COND0 * COND1 <= 0 "THEN" "GOTO" ZERO; COND0:= COND1 "END"; "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" D[I + 3]:= XL[I]:= X[I]; CHANGE: IV0:= IV; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" Y[J]:= FXJ; MAX:= ABS(Y[IV]); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" "IF" ABS(Y[I]) > MAX "THEN" "BEGIN" MAX:= ABS(Y[I]); IV:= I "END" "END"; "IF" IV0 ^= IV "THEN" "BEGIN" FIRST:= "TRUE"; D[0]:= IV; D[2]:= H:= Y[IV] / Y[IV0] * H "END"; X0:= XL[IV]; "IF" FIR "THEN" "BEGIN" HMIN:= E[0] + E[1]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" H:= E[2 * I] + E[2 * I + 1]; "IF" H < HMIN "THEN" HMIN:= H "END"; H:= E[2 * IV] + E[2 * IV + 1]; "IF" (FI "AND" (Y[L]/Y[IV]*H<0 "EQUIV" POS)) "OR" ("NOT" FI "AND" D[2]*H<0) "THEN" H:= -H "END"; I:= 1; "GOTO" AGAIN; ZERO: E1[1]:= E[2 * N + 2]; E1[2]:= E[2 * N + 3]; X1:=X[IV] ; S:=X0 ; ZEROIN(S,X1,FZERO,ABS(E1[1]*S) + ABS(E1[2])) ; X0:=S ; X1:=X[IV]; RKSTEP(X0 - XL[IV], 3); "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" D[I + 3]:= X[I] "END" RK4NA; "COMMENT" ================== 33080 =================; "BOOLEAN" "PROCEDURE" MULTISTEP(X,XEND,Y,HMIN,HMAX,YMAX,EPS, FIRST,SAVE,DERIV,AVAILABLE,JACOBIAN,STIFF,N,OUT); "VALUE" HMIN,HMAX,EPS,XEND,N,STIFF; "BOOLEAN" FIRST,AVAILABLE,STIFF; "INTEGER" N; "REAL" X,XEND,HMIN,HMAX,EPS; "ARRAY" Y,YMAX,SAVE,JACOBIAN; "PROCEDURE" DERIV,OUT; "BEGIN" "OWN" "BOOLEAN" ADAMS,WITH JACOBIAN; "OWN" "INTEGER" M,SAME,KOLD; "OWN" "REAL" XOLD,HOLD,A0,TOLUP,TOL,TOLDWN,TOLCONV; "BOOLEAN" EVALUATE,EVALUATED,DECOMPOSE,DECOMPOSED,CONV; "INTEGER" I,J,L,K,KNEW,FAILS; "REAL" H, CH, CHNEW,ERROR,DFI,C; "ARRAY" A[0:5],DELTA,LAST DELTA,DF[1:N],JAC[1:N, 1:N],AUX[1:3]; "INTEGER" "ARRAY" P[1:N]; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);"CODE" 34011; "REAL" "PROCEDURE" DEC(A,N,AUX,P); "CODE" 34300; "PROCEDURE" SOL(A,N,P,B); "CODE" 34051; "REAL" "PROCEDURE" NORM2(AI); "REAL" AI; "BEGIN" "REAL" S,A; S:= 1.0"-100; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" A:= AI/YMAX[I]; S:= S + A * A "END"; NORM2:= S "END" NORM2; "PROCEDURE" RESET; "BEGIN" "IF" CH < HMIN/HOLD "THEN" CH:= HMIN/HOLD "ELSE" "IF" CH > HMAX/HOLD "THEN" CH:= HMAX/HOLD; X:= XOLD; H:= HOLD * CH; C:= 1; "FOR" J:= 0 "STEP" M "UNTIL" K*M "DO" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" Y[J+I]:= SAVE[J+I] * C; C:= C * CH "END"; DECOMPOSED:= "FALSE" "END" RESET; "PROCEDURE" METHOD; "BEGIN" I:= -39; "IF" ADAMS "THEN" "BEGIN" "FOR" C:= 1,1,144,4,0,.5,1,.5,576,144,1,5/12,1, .75,1/6,1436,576,4,.375,1,11/12,1/3,1/24, 2844,1436,1,251/720,1,25/24,35/72, 5/48,1/120,0,2844,0.1 "DO" "BEGIN" I:= I+ 1; SAVE[I]:= C "END" "END" "ELSE" "BEGIN" "FOR" C:= 1,1,9,4,0,2/3,1,1/3,36,20.25,1,6/11, 1,6/11,1/11,84.028,53.778,0.25,.48,1,.7,.2,.02, 156.25, 108.51, .027778, 120/274, 1, 225/274, 85/274, 15/274, 1/274, 0, 187.69, .0047361 "DO" "BEGIN" I:= I + 1; SAVE[I]:= C "END" "END" "END" METHOD; "PROCEDURE" ORDER; "BEGIN" C:= EPS * EPS; J:= (K-1) * (K + 8)/2 - 38; "FOR" I:= 0 "STEP" 1 "UNTIL" K "DO" A[I]:= SAVE[I+J]; TOLUP := C * SAVE[J + K + 1]; TOL := C * SAVE[J + K + 2]; TOLDWN := C * SAVE[J + K + 3]; TOLCONV:= EPS/(2 * N * (K + 2)); A0:= A[0]; DECOMPOSE:= "TRUE"; "END" ORDER; "PROCEDURE" EVALUATE JACOBIAN; "BEGIN" EVALUATE:= "FALSE"; DECOMPOSE:= EVALUATED:= "TRUE"; "IF" AVAILABLE "THEN" "ELSE" "BEGIN" "REAL" D; "ARRAY" FIXY,FIXDY,DY[1:N]; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" FIXY[I]:= Y[I]; DERIV(FIXDY); "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D:= "IF" EPS > ABS(FIXY[J]) "THEN" EPS * EPS "ELSE" EPS * ABS(FIXY[J]); Y[J]:= Y[J] + D; DERIV(DY); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" JACOBIAN[I,J]:= (DY[I]-FIXDY[I])/D; Y[J]:= FIXY[J] "END" "END" "END" EVALUATE JACOBIAN; "PROCEDURE" DECOMPOSE JACOBIAN; "BEGIN" DECOMPOSE:= "FALSE"; DECOMPOSED:= "TRUE"; C:= -A0 * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" JAC[I,J]:= JACOBIAN[I,J] * C; JAC[J,J]:= JAC[J,J] + 1 "END"; AUX[2]:=1.0"-12; DEC(JAC,N,AUX,P) "END" DECOMPOSE JACOBIAN; "PROCEDURE" CALCULATE STEP AND ORDER; "BEGIN" "REAL" A1,A2,A3; A1:= "IF" K <= 1 "THEN" 0 "ELSE" 0.75 * (TOLDWN/NORM2(Y[K*M+I])) ** (0.5/K); A2:= 0.80 * (TOL/ERROR) ** (0.5/(K + 1)); A3:= "IF" K >= 5 "OR" FAILS ^= 0 "THEN" 0 "ELSE" 0.70 * (TOLUP/NORM2(DELTA[I] - LAST DELTA[I])) ** (0.5/(K+2)); "IF" A1 > A2 "AND" A1 > A3 "THEN" "BEGIN" KNEW:= K-1; CHNEW:= A1 "END" "ELSE" "IF" A2 > A3 "THEN" "BEGIN" KNEW:= K ; CHNEW:= A2 "END" "ELSE" "BEGIN" KNEW:= K+1; CHNEW:= A3 "END" "END" CALCULATE STEP AND ORDER; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; M:= N; "FOR" I:= -1,-2,-3 "DO" SAVE[I]:= 0; OUT(0,0); ADAMS:= "NOT" STIFF; WITH JACOBIAN:= "NOT" ADAMS; "IF" WITH JACOBIAN "THEN" EVALUATE JACOBIAN; METHOD; NEW START: K:= 1; SAME:= 2; ORDER; DERIV(DF); H:= "IF" "NOT" WITH JACOBIAN "THEN" HMIN "ELSE" SQRT(2 * EPS/SQRT(NORM2 (MATVEC(1,N,I,JACOBIAN,DF)))); "IF" H > HMAX "THEN" H:= HMAX "ELSE" "IF" H < HMIN "THEN" H:= HMIN; XOLD:= X; HOLD:= H; KOLD:= K; CH:= 1; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" SAVE[I]:= Y[I]; SAVE[M+I]:= Y[M+I]:= DF[I] * H "END"; OUT(0,0) "END" "ELSE" "BEGIN" WITH JACOBIAN:= "NOT" ADAMS; CH:= 1; K:=KOLD; RESET; ORDER; DECOMPOSE:= WITH JACOBIAN "END"; FAILS:= 0; "FOR" L:= 0 "WHILE" X < XEND "DO" "BEGIN" "IF" X + H <= XEND "THEN" X:= X + H "ELSE" "BEGIN" H:= XEND-X; X:= XEND; CH:= H/HOLD; C:= 1; "FOR" J:= M "STEP" M "UNTIL" K*M "DO" "BEGIN" C:= C* CH; "FOR" I:= J+1 "STEP" 1 "UNTIL" J+N "DO" Y[I]:= Y[I] * C "END"; SAME:= "IF" SAME<3 "THEN" 3 "ELSE" SAME+1; "END"; "COMMENT" PREDICTION; "FOR" L:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "FOR" I:= L "STEP" M "UNTIL" (K-1)*M+L "DO" "FOR" J:= (K-1)*M+L "STEP" -M "UNTIL" I "DO" Y[J]:= Y[J] + Y[J+M]; DELTA[L]:= 0 "END"; EVALUATED:= "FALSE"; "COMMENT" CORRECTION AND ESTIMATION LOCAL ERROR; "FOR" L:= 1,2,3 "DO" "BEGIN" DERIV(DF); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DF[I]:= DF[I] * H - Y[M+I]; "IF" WITH JACOBIAN "THEN" "BEGIN" "IF" EVALUATE "THEN" EVALUATE JACOBIAN; "IF" DECOMPOSE "THEN" DECOMPOSE JACOBIAN; SOL(JAC,N,P,DF) "END"; CONV:= "TRUE"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DFI:= DF[I]; Y[ I]:= Y[ I] + A0 * DFI; Y[M+I]:= Y[M+I] + DFI; DELTA[I]:= DELTA[I] + DFI; CONV:= CONV "AND" ABS(DFI) < TOLCONV * YMAX[I] "END"; "IF" CONV "THEN" "BEGIN" ERROR:= NORM2(DELTA[I]); "GOTO" CONVERGENCE "END" "END"; "COMMENT" ACCEPTANCE OR REJECTION; "IF" "NOT" CONV "THEN" "BEGIN" "IF" "NOT" WITH JACOBIAN "THEN" "BEGIN" EVALUATE:= WITH JACOBIAN:= SAME >= K "OR" H<1.1 * HMIN; "IF" "NOT" WITH JACOBIAN "THEN" CH:= CH/4; "END" "ELSE" "IF" "NOT" DECOMPOSED "THEN" DECOMPOSE:= "TRUE" "ELSE" "IF" "NOT" EVALUATED "THEN" EVALUATE := "TRUE" "ELSE" "IF" H > 1.1 * HMIN "THEN" CH:= CH/4 "ELSE" "IF" ADAMS "THEN" "GOTO" TRY CURTISS "ELSE" "BEGIN" SAVE[-1]:= 1; "GOTO" RETURN "END"; RESET "END" "ELSE" CONVERGENCE: "IF" ERROR > TOL "THEN" "BEGIN" FAILS:= FAILS + 1; "IF" H > 1.1 * HMIN "THEN" "BEGIN" "IF" FAILS > 2 "THEN" "BEGIN" "IF" ADAMS "THEN" "BEGIN" ADAMS:= "FALSE"; METHOD "END"; KOLD:= 0; RESET; "GOTO" NEW START "END" "ELSE" "BEGIN" CALCULATE STEP AND ORDER; "IF" KNEW ^= K "THEN" "BEGIN" K:= KNEW; ORDER "END"; CH:= CH * CHNEW; RESET "END" "END" "ELSE" "BEGIN" "IF" ADAMS "THEN" TRY CURTISS: "BEGIN" ADAMS:= "FALSE"; METHOD "END" "ELSE" "IF" K = 1 "THEN" "BEGIN" "COMMENT" VIOLATE EPS CRITERION; C:= EPS * SQRT(ERROR/TOL); "IF" C > SAVE[-3] "THEN" SAVE[-3]:= C; SAVE[-2]:= SAVE[-2] + 1; SAME:= 4; "GOTO" ERROR TEST OK "END"; K:= KOLD:= 1; RESET; ORDER; SAME:= 2 "END" "END" "ELSE" ERROR TEST OK: "BEGIN" FAILS:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" C:= DELTA[I]; "FOR" L:= 2 "STEP" 1 "UNTIL" K "DO" Y[L*M+I]:= Y[L*M+I] + A[L] * C; "IF" ABS(Y[I]) > YMAX[I] "THEN" YMAX[I]:= ABS(Y[I]) "END"; SAME:= SAME-1; "IF" SAME= 1 "THEN" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" LAST DELTA[I]:= DELTA[I] "END" "ELSE" "IF" SAME= 0 "THEN" "BEGIN" CALCULATE STEP AND ORDER; "IF" CHNEW > 1.1 "THEN" "BEGIN" DECOMPOSED:= "FALSE"; "IF" K ^= KNEW "THEN" "BEGIN" "IF" KNEW > K "THEN" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" Y[KNEW*M+I] := DELTA[I] * A[K]/KNEW "END"; K:= KNEW; ORDER "END"; SAME:= K+1; "IF" CHNEW * H > HMAX "THEN" CHNEW:= HMAX/H; H:= H * CHNEW; C:= 1; "FOR" J:= M "STEP" M "UNTIL" K*M "DO" "BEGIN" C:= C * CHNEW; "FOR" I:= J+1 "STEP" 1 "UNTIL" J+N "DO" Y[I]:= Y[I] * C "END" "END" "ELSE" SAME:= 10 "END"; "IF" X ^= XEND "THEN" "BEGIN" XOLD:= X; HOLD:= H; KOLD:= K; CH:= 1; "FOR" I:= K * M + N "STEP" -1 "UNTIL" 1 "DO" SAVE[I]:= Y[I]; OUT(H,K) "END" "END" CORRECTION AND ESTIMATION LOCAL ERROR; "END" STEP; RETURN: SAVE[0]:= "IF" ADAMS "THEN" 0 "ELSE" 1; MULTISTEP:= SAVE[-1]= 0 "AND" SAVE[-2]=0 "END" MULTISTEP; "COMMENT" ================== 33180 =================; "PROCEDURE" DIFFSYS(X,XE,N,Y,DERIVATIVE,AETA,RETA,S,H0,OUTPUT); "VALUE" N; "INTEGER" N; "REAL" X,XE,AETA,RETA,H0; "ARRAY" Y,S; "PROCEDURE" DERIVATIVE,OUTPUT; "BEGIN" "REAL" A,B,B1,C,G,H,U,V,TA,FC; "INTEGER" I,J,K,KK,JJ,L,M,R,SR; "ARRAY" YA,YL,YM,DY,DZ[1:N],DT[1:N,0:6],D[0:6],YG,YH[0:7,1:N]; "BOOLEAN" KONV,B0,BH,LAST; LAST:="FALSE"; H:=H0; NEXT: "IF" H*1.1>=XE-X "THEN" "BEGIN" LAST:="TRUE"; H0:=H; H:=XE-X+"-13 "END"; DERIVATIVE(X,Y,DZ); BH:="FALSE"; "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" YA[I]:=Y[I]; ANF: A:=H+X; FC:=1.5; B0:="FALSE"; M:=1; R:=2; SR:=3; JJ:=-1; "FOR" J:=0 "STEP" 1 "UNTIL" 9 "DO" "BEGIN" "IF" B0 "THEN" "BEGIN" D[1]:=16/9; D[3]:=64/9; D[5]:=256/9 "END" "ELSE" "BEGIN" D[1]:=9/4; D[3]:=9; D[5]:=36 "END"; KONV:="TRUE"; "IF" J>6 "THEN" "BEGIN" L:=6; D[6]:=64; FC:=.6*FC "END" "ELSE" "BEGIN" L:=J; D[L]:=M*M "END"; M:=M*2; G:=H/M; B:=G*2; "IF" BH "AND" J<8 "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YM[I]:=YH[J,I]; YL[I]:=YG[J,I] "END" "END" "ELSE" "BEGIN" KK:=(M-2)/2; M:=M-1; "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YL[I]:=YA[I]; YM[I]:=YA[I]+G*DZ[I] "END"; "FOR" K:=1 "STEP" 1 "UNTIL" M "DO" "BEGIN" DERIVATIVE(X+K*G,YM,DY); "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" U:=YL[I]+B*DY[I]; YL[I]:=YM[I]; YM[I]:=U; U:=ABS(U); "IF" U>S[I] "THEN" S[I]:=U "END"; "IF" K=KK "AND" K^=2 "THEN" "BEGIN" JJ:=JJ+1; "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YH[JJ,I]:=YM[I]; YG[JJ,I]:=YL[I] "END" "END" "END" "END"; DERIVATIVE(A,YM,DY); "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" V:=DT[I,0]; TA:=C:=DT[I,0]:=(YM[I]+YL[I]+G*DY[I])/2; "FOR" K:=1 "STEP" 1 "UNTIL" L "DO" "BEGIN" B1:=D[K]*V; B:=B1-C; U:=V; "IF" B^=0 "THEN" "BEGIN" B:=(C-V)/B; U:=C*B; C:=B1*B "END"; V:=DT[I,K]; DT[I,K]:=U; TA:=U+TA "END"; "IF" ABS(Y[I]-TA)>RETA*S[I]+AETA "THEN" KONV:="FALSE"; Y[I]:=TA "END"; "IF" KONV "THEN" "GOTO" END; D[2]:=4; D[4]:=16; B0:=^B0; M:=R; R:=SR; SR:=M*2 "END"; BH:=^BH; LAST:="FALSE"; H:=H/2; "GOTO" ANF; END: H:=FC*H; X:=A; OUTPUT; "IF" "NOT" LAST "THEN" "GOTO" NEXT; "END" DIFFSYS; "COMMENT" ================== 33061 =================; "PROCEDURE" ARK (T, TE, M0, M, U, DERIVATIVE, DATA, OUT); "INTEGER" M0, M; "REAL" T, TE; "ARRAY" U, DATA; "PROCEDURE" DERIVATIVE, OUT; "BEGIN" "INTEGER" P, N, Q; "OWN" "REAL" EC0, EC1, EC2, TAU0, TAU1, TAU2, TAUS, T2; "REAL" THETANM1, TAU, BETAN, QINV, ETA; "ARRAY" MU, LAMBDA[1:DATA[1]], THETHA[0:DATA[1]], RO, R[M0:M]; "BOOLEAN" START, STEP1, LAST; "PROCEDURE" INIVEC(L, U, A, X); "CODE" 31010; "PROCEDURE" MULVEC(L, U, SHIFT, A, B, X); "CODE" 31020; "PROCEDURE" DUPVEC(L, U, SHIFT, A, B); "CODE" 31030; "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010; "PROCEDURE" ELMVEC(L, U, SHIFT, A, B, X); "CODE" 34020; "PROCEDURE" DECSOL(A, N, AUX, B); "CODE" 34301; "PROCEDURE" INITIALIZE; "BEGIN" "INTEGER" I, J, K, L, N1; "REAL" S, THETA0; "ARRAY" ALFA[1:8, 1:DATA[1]+1], TH[1:8], AUX[1:3]; "REAL" "PROCEDURE" LABDA(I, J); "VALUE" I, J; "INTEGER" I, J; LABDA:= "IF" P < 3 "THEN" ("IF" J =I-1 "THEN" MUI(I) "ELSE" 0) "ELSE" "IF" P =3 "THEN" ("IF" I =N "THEN" ("IF" J=0 "THEN" .25 "ELSE" "IF" J =N - 1 "THEN" .75 "ELSE" 0) "ELSE" "IF" J =0 "THEN" ("IF" I =1 "THEN" MUI(1) "ELSE" .25) "ELSE" "IF" J =I - 1 "THEN" LAMBDA[I] "ELSE" 0) "ELSE" 0; "REAL" "PROCEDURE" MUI(I); "VALUE" I; "INTEGER" I; MUI:= "IF" I =N "THEN" 1 "ELSE" "IF" I < 1 ! I > N "THEN" 0 "ELSE" "IF" P < 3 "THEN" LAMBDA[I] "ELSE" "IF" P =3 "THEN" LAMBDA[I] + .25 "ELSE" 0; "REAL" "PROCEDURE" SUM(I, A, B, X); "VALUE" B; "INTEGER" I, A, B; "REAL" X; "BEGIN" "REAL" S; S:= 0; "FOR" I:= A "STEP" 1 "UNTIL" B "DO" S:= S + X; SUM:= S "END" SUM; N:= DATA[1]; P:= DATA[2]; EC1:= EC2 := 0; BETAN:= DATA[3]; THETANM1:= "IF" P=3 "THEN" .75 "ELSE" 1; THETA0:= 1 - THETANM1; S:= 1; "FOR" J:= N - 1 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" S:= - S * THETA0 + DATA[N + 10 - J]; MU[J]:= DATA[N + 11 - J] / S; LAMBDA[J]:= MU[J] - THETA0 "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" 8 "DO" "FOR" J:= 0 "STEP" 1 "UNTIL" N "DO" ALFA[I, J + 1]:= "IF" I = 1 "THEN" 1 "ELSE" "IF" J = 0 "THEN" 0 "ELSE" "IF" I = 2 ! I = 4 ! I = 8 "THEN" MUI(J) ** ENTIER((I + 2) / 3) "ELSE" "IF" (I = 3 ! I = 6) & J > 1 "THEN" SUM(L, 1, J-1, LABDA(J, L) * MUI(L) ** ENTIER(I / 3)) "ELSE" "IF" I = 5 & J > 2 "THEN" SUM(L, 2, J - 1, LABDA(J, L) * SUM(K, 1, L - 1, LABDA(L, K) * MUI(K))) "ELSE" "IF" I = 7 & J > 1 "THEN" SUM(L, 1, J - 1, LABDA(J, L) * MUI(L)) * MUI(J) "ELSE" 0; N1:="IF" N < 4 "THEN" N + 1 "ELSE" "IF" N < 7 "THEN" 4 "ELSE" 8; I:= 1; "FOR" S:= 1, .5, 1 / 6, 1 / 3, 1 / 24, 1 / 12, .125, .25 "DO" "BEGIN" TH[I]:= S; I:= I + 1 "END"; "IF" P = 3 & N < 7 "THEN" TH[1]:= TH[2]:= 0; AUX[2]:= " - 14; DECSOL(ALFA, N1, AUX, TH); INIVEC(0, N, THETHA, 0); DUPVEC(0, N1 - 1, 1, THETHA, TH); "IF" ^ (P = 3 & N < 7) "THEN" "BEGIN" THETHA[0]:= THETHA[0] - THETA0; THETHA[N - 1]:= THETHA[N - 1] - THETANM1; Q:= P + 1 "END" "ELSE" Q:= 3; QINV:= 1 / Q; START:= DATA[8] = 0; DATA[10]:= 0; LAST:= "FALSE"; DUPVEC(M0, M, 0, R, U); DERIVATIVE(T, R) "END" INITIALIZE; "PROCEDURE" LOCAL ERROR CONSTRUCTION(I); "VALUE" I; "INTEGER" I; "BEGIN" "IF" THETHA[I] ^= 0 "THEN" ELMVEC(M0, M, 0, RO, R, THETHA[I]); "IF" I = N "THEN" "BEGIN" DATA[9]:= SQRT(VECVEC(M0, M, 0, RO, RO))* TAU; EC0:= EC1; EC1:= EC2; EC2:= DATA[9] / TAU ** Q "END" "END" LEC; "PROCEDURE" STEPSIZE; "BEGIN" "REAL" TAUACC, TAUSTAB, AA, BB, CC, EC; ETA:= SQRT(VECVEC(M0, M, 0, U, U)) * DATA[7] + DATA[6]; "IF" ETA > 0 "THEN" "BEGIN" "IF" START "THEN" "BEGIN" "IF" DATA[8] = 0 "THEN" "BEGIN" TAUACC:= DATA[5]; STEP1:= "TRUE" "END" "ELSE" "IF" STEP1 "THEN" "BEGIN" TAUACC:= (ETA / EC2) ** QINV; "IF" TAUACC > 10 * TAU2 "THEN" TAUACC:= 10 * TAU2 "ELSE" STEP1:= "FALSE" "END" "ELSE" "BEGIN" BB:= (EC2 - EC1) / TAU1; CC:= - BB * T2 + EC2; EC:= BB * T + CC; TAUACC:= "IF" EC < 0 "THEN" TAU2 "ELSE" (ETA / EC) ** QINV; START:= "FALSE" "END" "END" "ELSE" "BEGIN" AA:= ((EC0 - EC1) / TAU0 + (EC2 - EC1) / TAU1) / (TAU1 + TAU0); BB:= (EC2 - EC1) / TAU1 - (2 * T2 - TAU1) * AA; CC:= - (AA * T2 + BB) * T2 + EC2; EC:= (AA * T + BB) * T + CC; TAUACC:= "IF" EC < 0 "THEN" TAUS "ELSE" (ETA / EC) ** QINV; "IF" TAUACC > 2 * TAUS "THEN" TAUACC:= 2 * TAUS; "IF" TAUACC < TAUS / 2 "THEN" TAUACC:= TAUS / 2 "END" "END" "ELSE" TAUACC:= DATA[5]; "IF" TAUACC < DATA[5] "THEN" TAUACC:= DATA[5]; TAUSTAB:= BETAN / DATA[4]; "IF" TAUSTAB < DATA[5] "THEN" "BEGIN" DATA[10]:= 1; "GOTO" ENDARK "END"; TAU:= "IF" TAUACC > TAUSTAB "THEN" TAUSTAB "ELSE" TAUACC; TAUS:= TAU; "IF" TAU >= TE - T "THEN" "BEGIN" TAU:= TE - T; LAST:= "TRUE" "END"; TAU0:= TAU1; TAU1:= TAU2; TAU2:= TAU "END" STEPSIZE; "PROCEDURE" DIFFERENCE SCHEME; "BEGIN" "INTEGER" I, J; "REAL" MT, LT; MULVEC(M0, M, 0, RO, R, THETHA[0]); "IF" P = 3 "THEN" ELMVEC(M0, M, 0, U, R, .25 * TAU); "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" MT:= MU[I] * TAU; LT:= LAMBDA[I] * TAU; "FOR" J:= M0 "STEP" 1 "UNTIL" M "DO" R[J]:= LT * R[J] + U[J]; DERIVATIVE(T + MT, R); LOCAL ERROR CONSTRUCTION(I) "END"; ELMVEC(M0, M, 0, U, R, THETANM1 * TAU); DUPVEC(M0, M, 0, R, U); DERIVATIVE(T + TAU, R); LOCAL ERROR CONSTRUCTION(N); T2:= T; "IF" LAST "THEN" "BEGIN" LAST:= "FALSE"; T:= TE "END" "ELSE" T:= T + TAU; DATA[8]:= DATA[8]+1 "END" DIFSCH; INITIALIZE; NEXT STEP: STEPSIZE; DIFFERENCE SCHEME; OUT; "IF" T ^= TE "THEN" "GOTO" NEXT STEP; ENDARK: "END" ARK; "COMMENT" ================== 33070 =================; "PROCEDURE" EFRK(T,TE,M0,M,U,SIGMA,PHI,DIAMETER,DERIVATIVE,K,STEP,R,L, BETA,THIRDORDER,TOL,OUTPUT); "VALUE" R,L; "INTEGER" M0,M,K,R,L; "REAL" T,TE,SIGMA,PHI,DIAMETER,STEP,TOL; "ARRAY" U,BETA; "BOOLEAN" THIRDORDER; "PROCEDURE" DERIVATIVE,OUTPUT; "BEGIN" "INTEGER" N; "REAL" THETA0,THETANM1,H,B,B0,PHI0,PHIL,PI,COSPHI,SINPHI,EPS,BETAR; "BOOLEAN" FIRST,LAST,COMPLEX,CHANGE; "INTEGER" "ARRAY" P[1:L]; "REAL" "ARRAY" MU,LABDA[0:R+L-1],PT[0:R],FAC,BETAC[0:L-1],RL[M0:M], A[1:L,1:L],AUX[0:3]; "PROCEDURE" ELMVEC(L,U,SHIFT,A,B,X); "CODE" 34020; "PROCEDURE" SOL(A,N,P,B); "CODE" 34051; "PROCEDURE" DEC(A,N,AUX,P); "CODE" 34300; "PROCEDURE" FORM CONSTANTS; "BEGIN" "INTEGER" I; FIRST:="FALSE"; FAC[0]:=1; "FOR" I:=1 "STEP" 1 "UNTIL" L-1 "DO" FAC[I]:=I*FAC[I-1]; PT[R]:=L*FAC[L-1]; "FOR" I:=1 "STEP" 1 "UNTIL" R "DO" PT[R-I]:=PT[R-I+1]*(L+I)/I "END" FORM CONSTANTS; "PROCEDURE" FORM BETA; "BEGIN" "INTEGER" I,J; "REAL" BB,C,D; "IF" FIRST "THEN" FORM CONSTANTS; "IF" L=1 "THEN" "BEGIN" C:=1-EXP(-B); "FOR" J:=1 "STEP" 1 "UNTIL" R "DO" C:=BETA[J]-C/B; BETA[R+1]:=C/B "END" "ELSE" "IF" B>40 "THEN" "BEGIN" "FOR" I:=R+1 "STEP" 1 "UNTIL" R+L "DO" "BEGIN" C:=0; "FOR" J:=0 "STEP" 1 "UNTIL" R "DO" C:=BETA[J]*PT[J]/(I-J)-C/B; BETA[I]:=C/B/FAC[L+R-I]/FAC[I-R-1] "END"; "END" "ELSE" "BEGIN" D:=C:=EXP(-B); BETAC[L-1]:=D/FAC[L-1]; "FOR" I:=1 "STEP" 1 "UNTIL" L-1 "DO" "BEGIN" C:=B*C/I; D:=D+C; BETAC[L-1-I]:=D/FAC[L-1-I] "END"; BB:=1; "FOR" I:=R+1 "STEP" 1 "UNTIL" R+L "DO" "BEGIN" C:=0; "FOR" J:=0 "STEP" 1 "UNTIL" R "DO" C:=(BETA[J]-("IF" JL-2 "THEN" 2 "ELSE" L-2*I; COSPHIL :=COSIPHI*COSPHI-SINIPHI*SINPHI; SINIPHI:=COSIPHI*SINPHI+SINIPHI*COSPHI; COSIPHI:=COSPHIL; "FOR" J:=L "STEP" -2 "UNTIL" C3 "DO" "BEGIN" D[J]:=D[J]+ZI*C2*SINIPHI; D[J-1]:=D[J-1]-ZI*C2*COSIPHI; C2:=C2*C1; C1:=C1-1 "END"; ZI:=ZI*B1 "END" "END" RIGHT HAND SIDE; "IF" PHI0^=PHIL "THEN" ELEMENTS OF MATRIX; RIGHTHANDSIDE; SOL(A,L,P,D); "FOR" I:=1 "STEP" 1 "UNTIL" L "DO" BETA[R+I]:=D[L+1-I]*B1 "END" SOLOFCOMEQ; "PROCEDURE" COEFFICIENT; "BEGIN" "INTEGER" J,K; "REAL" C; B0:=B; PHI0:=PHI; "IF" B>=1 "THEN" "BEGIN" "IF" COMPLEX "THEN" SOLUTION OF COMPLEX EQUATIONS "ELSE" FORM BETA "END"; LABDA[0]:=MU[0]:=0; "IF" THIRDORDER "THEN" "BEGIN" THETA0:=.25; THETANM1:=.75; "IF" B<1 "THEN" "BEGIN" C:=MU[N-1]:=2/3; LABDA[N-1]:=5/12; "FOR" J:=N-2 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" C:=MU[J]:=C/(C-.25)/(N-J+1); LABDA[J]:=C-.25 "END" "END" "ELSE" "BEGIN" C:=MU[N-1]:=BETA[2]*4/3; LABDA[N-1]:=C-.25; "FOR" J:=N-2 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" C:=MU[J]:=C/(C-.25)*BETA[N-J+1]/BETA[N-J]/ ("IF" JDIAMETER; "IF" DIAMETER>0 "THEN" HSTAB:=(SIGMA**2/(DIAMETER*(DIAMETER*.25+D)))**(L*.5/R)/ BETAR/SIGMA "ELSE" HSTAB:=H; D:= "IF" THIRDORDER "THEN" (2*TOL/EPS/BETA[R])**(1/(N-1))* 4**((L-1)/(N-1)) "ELSE" (TOL/EPS)**(1/R)/BETAR; HSTABINT:= ABS(D/SIGMA); "IF" H>HSTAB "THEN" H:=HSTAB; "IF" H>HSTABINT "THEN" H:=HSTABINT; "IF" T+H>TE*(1-K*EPS) "THEN" "BEGIN" LAST:="TRUE"; H:=TE-T "END"; B:=H*SIGMA; D:=DIAMETER*.1*H; D:=D*D; "IF" HD) "END" STEPSIZE; "PROCEDURE" DIFFERENCESCHEME ; "BEGIN" "INTEGER" I,J; "REAL" MT,LT,THT; I:=-1; NEXTTERM: I:=I+1; MT:=MU[I]*H; LT:=LABDA[I]*H; "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO" RL[J]:=U[J]+LT*RL[J]; DERIVATIVE(T+MT,RL); "IF" I=0 "OR" I=N-1 "THEN" "BEGIN" THT:="IF" I=0 "THEN" THETA0*H "ELSE" THETANM1*H; ELMVEC(M0,M,0,U,RL,THT) "END"; "IF" I HMAX "THEN" S:= H:= HMAX "END"; "IF" X + S > XE "THEN" S:= XE - X; LIN:= STEP = S "AND" LINEAR; STEPSIZE:= S "END" STEPSIZE; "PROCEDURE" COEFFICIENT; "BEGIN" "REAL" Z1, E, ALPHA1, A, B; "OWN" "REAL" Z2; Z1:= STEP * DELTA; "IF" N = 1 "THEN" Z2:= Z1 + Z1; "IF" ABS(Z2 - Z1) > " - 6 * ABS(Z1) "OR" Z2 > - 1 "THEN" "BEGIN" A:= Z1 * Z1 + 12; B:= 6 * Z1; "IF" ABS(Z1) < 0.1 "THEN" ALPHA1:= (Z1 * Z1 / 140 - 1) * Z1 / 30 "ELSE" "IF" Z1 < - "14 "THEN" ALPHA1:= 1 / 3 "ELSE" "IF" Z1 < - 33 "THEN" ALPHA1:= (A + B) / (3 * Z1 * (2 + Z1)) "ELSE" "BEGIN" E:= "IF" Z1 < 230 "THEN" EXP(Z1) "ELSE" "100; ALPHA1:= ((A - B) * E - A - B) / (((2 - Z1) * E - 2 - Z1) * 3 * Z1) "END"; MU2:= (1 / 3 + ALPHA1) * 0.25; MU1:= - (1 + ALPHA1) * 0.5; MU0:= (6 * MU1 + 2) / 9; THETA0:= 0.25; THETA1:= 0.75; A:= 3 * ALPHA1; NU3:= (1 + A) / (5 - A) * 0.5; A:= NU3 + NU3; NU1:= 0.5 - A; NU2:= (1 + A) * 0.75; Z2:= Z1 "END" "END" COEFFICIENT; "PROCEDURE" DIFFERENCE SCHEME; "BEGIN" DERIVATIVE(F); STEP:= STEPSIZE; "IF" "NOT" LINEAR "OR" N = 1 "THEN" JACOBIAN(J, Y); "IF" "NOT" LIN "THEN" "BEGIN" COEFFICIENT; C1:= STEP * MU1; D:= STEP * STEP * MU2; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" "FOR" L:= 1 "STEP" 1 "UNTIL" M "DO" J1[K,L]:= D * MATMAT(1, M, K, L, J, J) + C1 * J[K,L]; J1[K,K]:= J1[K,K] + 1 "END"; GSSELM(J1, M, AUX, RI, CI) "END"; C1:= STEP * STEP * MU0; D:= STEP * 2 / 3; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" K0[K]:= FK:= F[K]; LABDA[K]:= D * FK + C1 * MATVEC(1, M, K, J, F) "END"; SOLELM(J1, M, RI, CI, LABDA); "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" F[K]:= Y[K] + LABDA[K]; DERIVATIVE(F); C1:= THETA0 * STEP; C2:= THETA1 * STEP; D:= NU1 * STEP; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" YK:= Y[K]; FK:= F[K]; LABDA[K]:= YK + D * FK + NU2 * LABDA[K]; Y[K]:= F[K]:= YK + C1 * K0[K] + C2 * FK "END" "END" DIFFERENCE SCHEME; AUX[2]:= "-14; AUX[4]:= 8; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO" F[K]:= Y[K]; N:= 0; OUTPUT; STEP:= 0; NEXT STEP: N:= N + 1; DIFFERENCE SCHEME; X:= X + STEP; OUTPUT; "IF" X < XE "THEN" "GOTO" NEXT STEP "END" EFSIRK; "COMMENT" ================== 33120 =================; "PROCEDURE" EFERK(X,XE,M,Y,SIGMA,PHI,DERIVATIVE,J,JACOBIAN, K,L,AUT,AETA,RETA,HMIN,HMAX,LINEAR,OUTPUT); "VALUE" L; "INTEGER" M,K,L; "REAL" X,XE,SIGMA,PHI,AETA,RETA,HMIN,HMAX; "ARRAY" Y,J; "BOOLEAN" AUT,LINEAR; "PROCEDURE" DERIVATIVE,JACOBIAN,OUTPUT; "BEGIN" "INTEGER" M1,I; "REAL" H,B,B0,PHI0,COSPHI,SINPHI,ETA,DISCR,FAC,PI; "BOOLEAN" CHANGE,LAST; "INTEGER" "ARRAY" P[1:L]; "REAL" "ARRAY" BETA,BETHA[0:L],BETAC[0:L+3],K0,D,D1,D2[1:M], A[1:L,1:L],AUX[1:3]; "REAL" "PROCEDURE" VECVEC(L,U,SHIFT,A,B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B); "CODE" 34011; "PROCEDURE" DEC(A,N,AUX,P); "CODE" 34300; "PROCEDURE" SOL(A,N,P,B); "CODE" 34051; "REAL" "PROCEDURE" SUM(I,L,U,T); "VALUE" L,U; "INTEGER" I,L,U; "REAL" T; "BEGIN" "REAL" S; S:=0; "FOR" I:=L "STEP" 1 "UNTIL" U "DO" S:=S+T; SUM:=S "END"; "PROCEDURE" FORMBETA; "IF" L=1 "THEN" "BEGIN" BETHA[1]:=(.5-(1-(1-EXP(-B))/B)/B)/B; BETA[1]:=(1/6-BETHA[1])/B "END" "ELSE" "IF" L=2 "THEN" "BEGIN" "REAL" E,EMIN1; E:=EXP(-B); EMIN1:=E-1; BETHA[1]:=(1-(3+E+4*EMIN1/B)/B)/B; BETHA[2]:=(.5-(2+E+3*EMIN1/B)/B)/B/B; BETA[2]:=(1/6-BETHA[1])/B/B; BETA[1]:=(1/3-(1.5-(4+E+5*EMIN1/B)/B)/B)/B "END" "ELSE" "BEGIN" "REAL" B0,B1,B2,A0,A1,A2,A3,C,D; BETAC[L-1]:=C:=D:=EXP(-B)/FAC; "FOR" I:=L-1 "STEP" -1 "UNTIL" 1 "DO" "BEGIN" C:=I*B*C/(L-I); BETAC[I-1]:=D:=D*I+C "END"; B2:=.5-BETAC[2]; B1:=(1-BETAC[1])*(L+1)/B; B0:=(1-BETAC[0])*(L+2)*(L+1)*.5/B/B; A3:=1/6-BETAC[3]; A2:=B2*(L+1)/B; A1:=B1*(L+2)*.5/B; A0:=B0*(L+3)/3/B; D:=L/B; "FOR" I:=1 "STEP" 1 "UNTIL" L "DO" "BEGIN"BETA[I]:=(A3/I-A2/(I+1)+A1/(I+2)-A0/(I+3))*D+BETAC[I+3]; BETHA[I]:=(B2/I-B1/(I+1)+B0/(I+2))*D+BETAC[I+2]; D:=D*(L-I)/I/B; "END" "END" FORMBETA; "PROCEDURE" SOLUTIONOFCOMPLEXEQUATIONS; "IF" L=2 "THEN" "BEGIN" "REAL" COS2PHI,COSA,SINA,E,ZI; PHI0:=PHI; COSPHI:=COS(PHI0); SINPHI:=SIN(PHI0); E:=EXP(B*COSPHI); ZI:=B*SINPHI-3*PHI0; SINA:=("IF" ABS(SINPHI)<"-6 "THEN" -E*(B+3) "ELSE" E*SIN(ZI)/SINPHI); COS2PHI:=2*COSPHI*COSPHI-1; BETHA[2]:=(.5+(2*COSPHI+(1+2*COS2PHI+SINA)/B)/B)/B/B; SINA:=("IF" ABS(SINPHI)<"-6 "THEN" E*(B+4) "ELSE" SINA*COSPHI-E*COS(ZI)); BETHA[1]:=-(COSPHI+(1+2*COS2PHI+(4*COSPHI*COS2PHI+SINA) /B)/B)/B; BETA[1]:=BETHA[2]+2*COSPHI*(BETHA[1]-1/6)/B; BETA[2]:=(1/6-BETHA[1])/B/B "END" "ELSE" "BEGIN" "INTEGER" J,C1; "REAL" C2,E,ZI,COSIPHI,SINIPHI,COSPHIL; "REAL" "ARRAY" D[1:L]; "PROCEDURE" ELEMENTS OF MATRIX; "BEGIN" PHI0:=PHI; COSPHI:=COS(PHI0); SINPHI:=SIN(PHI0); COSIPHI:=1; SINIPHI:=0; "FOR" I:=0 "STEP" 1 "UNTIL" L-1 "DO" "BEGIN" C1:=4+I; C2:=1; "FOR" J:=L-1 "STEP" -2 "UNTIL" 1 "DO" "BEGIN" A[J,L-I]:=C2*COSIPHI; A[J+1,L-I]:=C2*SINIPHI; C2:=C2*C1; C1:=C1-1 "END"; COSPHIL:=COSIPHI*COSPHI-SINIPHI*SINPHI; SINIPHI:=COSIPHI*SINPHI+SINIPHI*COSPHI; COSIPHI:=COSPHIL "END"; AUX[2]:=0; DEC(A,L,AUX,P) "END" EL OF MAT; "PROCEDURE" RIGHT HAND SIDE; "BEGIN" E:=EXP(B*COSPHI); ZI:=B*SINPHI-4*PHI0; COSIPHI:=E*COS(ZI); SINIPHI:=E*SIN(ZI); ZI:=1/B/B/B; "FOR" J:=L "STEP" -2 "UNTIL" 2 "DO" "BEGIN" D[J]:=ZI*SINIPHI; D[J-1]:=ZI*COSIPHI; COSPHIL:=COSIPHI*COSPHI-SINIPHI*SINPHI; SINIPHI:=COSIPHI*SINPHI+SINIPHI*COSPHI; COSIPHI:=COSPHIL; ZI:=ZI*B "END"; SINIPHI:=2*SINPHI*COSPHI; COSIPHI:=2*COSPHI*COSPHI-1; COSPHIL:=COSPHI*(2*COSIPHI-1); D[L]:=D[L]+SINPHI*(1/6+(COSPHI+(1+2*COSIPHI*(1+2*COSPHI/B)) /B)/B); D[L-1]:=D[L-1]-COSPHI/6-(.5*COSIPHI+(COSPHIL+(2*COSIPHI* COSIPHI-1)/B)/B)/B; D[L-2]:=D[L-2]+SINPHI*(.5+(2*COSPHI+(2*COSIPHI+1)/B)/B); D[L-3]:=D[L-3]-.5*COSPHI-(COSIPHI+COSPHIL/B)/B; "IF" L<5 "THEN" "GOTO" END; D[L-4]:=D[L-4]+SINPHI+SINIPHI/B; D[L-5]:=D[L-5]-COSPHI-COSIPHI/B; "IF" L<7 "THEN" "GOTO" END; D[L-6]:=D[L-6]+SINPHI; D[L-7]:=D[L-7]-COSPHI; END: "END" RHS; "IF" PHI0^=PHI "THEN" ELEMENTS OF MATRIX; RIGHT HAND SIDE; SOL(A,L,P,D); ZI:=1/B; "FOR" I:=1 "STEP" 1 "UNTIL" L "DO" "BEGIN" BETA[I]:=D[L+1-I]*ZI; BETHA[I]:=(I+3)*BETA[I]; ZI:=ZI/B "END" "END" SOLOFEQCOM; "PROCEDURE" COEFFICIENT; "BEGIN" B0:=B:=ABS(H*SIGMA); "IF" B>=.1 "THEN" "BEGIN" "IF" PHI^=PI "AND" L=2 "OR" ABS(PHI-PI)>.01 "THEN" SOLUTION OF COMPLEX EQUATIONS "ELSE" FORMBETA "END" "ELSE" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" L "DO" "BEGIN" BETHA[I]:=BETA[I-1]; BETA[I]:=BETA[I-1]/(I+3); "END" "END" "END" COEFFICIENT; "PROCEDURE" LOCAL ERROR BOUND; ETA:=AETA+RETA*SQRT(VECVEC(1,M1,0,Y,Y)); "PROCEDURE" STEPSIZE; "BEGIN" LOCAL ERROR BOUND; "IF" K=0 "THEN" "BEGIN" DISCR:=SQRT(VECVEC(1,M1,0,D,D)); H:=ETA/DISCR "END" "ELSE" "BEGIN" DISCR:=H*SQRT(SUM(I,1,M1,(D[I]-D2[I])**2))/ETA; H:=H*("IF" LINEAR "THEN" 4/(4+DISCR)+.5 "ELSE" 4/(3+DISCR)+1/3) "END"; "IF" HHMAX "THEN" H:=HMAX; B:=ABS(H*SIGMA); CHANGE:=ABS(1-B/B0)>.05 "OR" PHI^=PHI0; "IF" 1.1*H>=XE-X "THEN" "BEGIN" CHANGE:=LAST:="TRUE"; H:=XE-X "END"; "IF" "NOT" CHANGE "THEN" H:=H*B0/B "END" STEPSIZE; "PROCEDURE" DIFFERENCE SCHEME; "BEGIN" "INTEGER" K; "REAL" BETAI,BETHAI; "IF" M1=XE-X "THEN" "BEGIN" LAST:="TRUE"; H:=XE-X; X:=XE "END" "ELSE" X:=X+H "END" STEPSIZE; "PROCEDURE" COEFFICIENT; "BEGIN" "REAL" R1,R2,EX,ZETA,ETA,SINL,COSL,SINH,COSH,D; "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X; "IF" X>40 "THEN" R:=X/(X-2) "ELSE" "BEGIN" EX:=EXP(-X); R:=X*(1-EX)/(X-2+(X+2)*EX) "END"; B1:=H*SIGMA1; B2:=H*SIGMA2; "IF" B1<.1 "THEN" "BEGIN" P:=0; Q:=1/3; "GOTO" OUT "END"; "IF" B2<0 "THEN" "GOTO" COMPLEX; "IF" B1<1 "OR" B2<.1 "THEN" "GOTO" THIRDORDER; "IF" ABS(B1-B2)40 "THEN" EX:=0; R2:=B1/(1-EX); R2:=1-EX*R2*R2; Q:=1/(R1*R1*R2); P:=R1*Q-2/B1; "GOTO" OUT; COMPLEX: ETA:=ABS(B1*SIN(SIGMA2)); ZETA:=ABS(B1*COS(SIGMA2)); "IF" ETA40 "THEN" "BEGIN" P:=1-4*ZETA/B1/B1; Q:=4*(1-ZETA)/B1/B1+1 "END" "ELSE" "BEGIN" EX:=EXP(ZETA); SINL:=SIN(ETA); COSL:=COS(ETA); SINH:=.5*(EX-1/EX); COSH:=.5*(EX+1/EX); D:=ETA*(COSH-COSL)-.5*B1*B1*SINL; P:=(ZETA*SINL+ETA*SINH-4*ZETA*ETA/B1/B1*(COSH-COSL))/D; Q:=ETA*((COSH-COSL-ZETA*SINH-ETA*SINL)*4/B1/B1+COSH+COSL)/D "END"; OUT: C0:=.25*H*H*(P+Q); C1:=.5*H*(1+P); C2:=H-C1; C3:=.25*H*H*(Q-P); C4:=.5*H*P; ELEMENTS OF MATRIX "END" COEFFICIENT; "PROCEDURE" ELEMENTS OF MATRIX; "BEGIN" "INTEGER" K; "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" "BEGIN" "FOR" K:=1 "STEP" 1 "UNTIL" M "DO" A[I,K]:=C0*MATMAT(1,M,I,K,J,J)-C1*J[I,K]; A[I,I]:=A[I,I]+1 "END"; AUX[2]:=0; DEC(A,M,AUX,PI) "END" ELOFMAT; "PROCEDURE" NEWTON ITERATION; "BEGIN" "INTEGER" ITNUM; "REAL" JFL,ETA,DISCR; ITNUM:=0; NEXT: ITNUM:=ITNUM+1; "IF" EVALUATE(ITNUM) "THEN" "BEGIN" JACOBIAN(J,Y); COEFFICIENT "END" "ELSE" "IF" ITNUM=1 "AND" H^=HL "THEN" COEFFICIENT; "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" FL[I]:=F(I); "IF" ITNUM=1 "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" "BEGIN" JFL:=MATVEC(1,M,I,J,FL); DY[I]:=H*(FL[I]-C4*JFL); YL[I]:=Y[I]+C2*FL[I]+C3*JFL "END" "END" "ELSE" "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" DY[I]:=YL[I]-Y[I]+C1*FL[I]-C0*MATVEC(1,M,I,J,FL); SOL(A,M,PI,DY); "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" Y[I]:=Y[I]+DY[I]; "IF" ITNUMS "THEN" S:=X "END" "END" "ELSE" S:=SQRT(VECVEC(M0,M,0,W,W)); NORMFUNCTION:=S "END"; "PROCEDURE" LOCAL ERROR BOUND; ETA:=AETA+RETA * NORMFUNCTION(NORM,U); "PROCEDURE" LOCAL ERROR CONSTRUCTION(I);"INTEGER" I; "BEGIN" "IF" I=P "THEN" "BEGIN" ECL:=0;TAUEC:=1 "END"; "IF" I>P+1 "THEN" TAUEC:=TAUEC*TAU; ECL:=ECL+ABS(BETHA[I])*TAUEC*NORMFUNCTION(NORM,C); "IF" I=N "THEN" "BEGIN" EC0:=EC1;EC1:=EC2;EC2:=ECL; RHO:=ECL*TAU**Q "END" "END"; "PROCEDURE" STEPSIZE; "BEGIN" "REAL" TAUACC,TAUSTAB,AA,BB,CC,EC; LOCAL ERROR BOUND; "IF" ETA>0 "THEN" "BEGIN" "IF" START "THEN" "BEGIN" "IF" K=0 "THEN" "BEGIN" "INTEGER" J; "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO" C[J]:=U[J]; I:=1; DERIVATIVE(I,C); TAUACC:=ETA/NORMFUNCTION(NORM,C); STEP1:="TRUE" "END" "ELSE" "IF" STEP1 "THEN" "BEGIN" TAUACC:=(ETA/RHO)**(1/Q)*TAU2; "IF" TAUACC>10*TAU2 "THEN" TAUACC:=10*TAU2 "ELSE" STEP1:="FALSE" "END" "ELSE" "BEGIN" BB:=(EC2-EC1)/TAU1; CC:=EC2-BB*T2; EC:=BB*T+CC; TAUACC:="IF" EC<0 "THEN" TAU2 "ELSE" (ETA/EC)**(1/Q); START:="FALSE" "END" "END" "ELSE" "BEGIN" AA:=((EC0-EC1)/TAU0+(EC2-EC1)/TAU1)/ (TAU1+TAU0); BB:=(EC2-EC1)/TAU1-AA*(2*T2-TAU1); CC:=EC2-T2*(BB+AA*T2); EC:=CC+T*(BB+T*AA); TAUACC:="IF" EC<0 "THEN" TAUS "ELSE" (ETA/EC)**(1/Q); "IF" TAUACC>ALFA*TAUS "THEN" TAUACC:=ALFA*TAUS; "IF" TAUACCTAUSTAB "THEN" TAUSTAB "ELSE" TAUACC; TAUS:=TAU; "IF" TAU>=TE-T "THEN" "BEGIN" TAU:=TE-T;LAST:= "TRUE" "END"; TAU0:=TAU1;TAU1:=TAU2;TAU2:=TAU "END"; "PROCEDURE" DIFFERENCE SCHEME; "BEGIN" "INTEGER" J; "REAL" B; "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO" C[J]:=U[J]; TAUI:=1; NEXT TERM: I:=I+1; DERIVATIVE(I,C); TAUI:=TAUI*TAU; B:=BETA[I]*TAUI; "IF" ETA>0 "AND" I>=P "THEN" LOCAL ERROR CONSTRUCTION(I); "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO" U[J]:=U[J]+B*C[J]; "IF" IS "THEN" S:=X "END" "END" "ELSE" S:=SQRT(VECVEC(M0,M,0,W,W)); NORMFUNCTION:=S; "END"; "PROCEDURE" LOCAL ERROR BOUND; ETA:=AETA+RETA * NORMFUNCTION(NORM,U); "PROCEDURE" LOCAL ERROR CONSTRUCTION(I); "INTEGER" I; "BEGIN" "IF" I=1 "THEN" INIVEC(M0,M,RO,0); "IF" I<4 "THEN" ELMVEC(M0,M,0,RO,C,BETHA[I]*HI); "IF" I=4 "THEN" "BEGIN" ELMVEC(M0,M,0,RO,C,-H); RHO:=NORMFUNCTION(NORM,RO); EC0:=EC1;EC1:=EC2;EC2:=RHO/H**Q; "END" "END"; "PROCEDURE" STEPSIZE; "BEGIN" "REAL" HACC,HSTAB,HCR,HMAX,A,B,C; "IF" "NOT" START "THEN" LOCAL ERROR BOUND; "IF" START "THEN" "BEGIN" H1:=H2:=HACC:=HSTART; EC2:=EC1:=1; KL:=1; START:="FALSE" "END" "ELSE" "IF" KL<3 "THEN" "BEGIN" HACC:=(ETA/RHO)**(1/Q)*H2; "IF" HACC>10*H2 "THEN" HACC:=10*H2 "ELSE" KL:=KL+1 "END" "ELSE" "BEGIN" A:=(H0*(EC2-EC1)-H1*(EC1-EC0))/(H2*H0-H1*H1); H:=H2*("IF" ETA0 "THEN" "BEGIN" B:=(EC2-EC1-A*(H2-H1))/H1; C:=EC2-A*H2-B*T2; HACC:=0; HMAX:=H; "IF" ^ZEROIN(HACC,H,HACC**Q*(A*HACC+B*T+C)-ETA, "-3*H2) "THEN" HACC:=HMAX "END" "ELSE" HACC:=H; "IF" HACC<.5*H2 "THEN" HACC:=.5*H2; "END"; "IF" HACC1 "THEN" "BEGIN" A:=ABS(DIAMETER/SIGMAL+"-14)/2; B:=2*ABS(SIN(PHIL)); BETAN:=("IF" A>B "THEN" 1/A "ELSE" 1/B)/A; HSTAB:=ABS(BETAN/SIGMAL); "IF" HSTAB<"-14*T "THEN" "GOTO" ENDOFEFT; "IF" H>HSTAB "THEN" H:=HSTAB "END"; HCR:=H2*H2/H1; "IF" KL>2 "AND" ABS(H-HCR)<"-6*HCR "THEN" H:="IF" HTE "THEN" "BEGIN" LAST:="TRUE"; HSTART:=H; H:=TE-T "END"; H0:=H1;H1:=H2;H2:=H; "END"; "PROCEDURE" DIFFERENCE SCHEME; "BEGIN" HI:=1; SIGMAL:=SIGMA; PHIL:=PHI; STEPSIZE; COEFFICIENT; "FOR" I:=1,2,3 "DO" "BEGIN" HI:=HI*H; "IF" I>1 "THEN" DERIVATIVE(I,C); LOCALERRORCONSTRUCTION(I); ELMVEC(M0,M,0,U,C,BETA[I]*HI) "END"; T2:=T; K:=K+1; "IF" LAST "THEN" "BEGIN" LAST:="FALSE"; T:=TE; START:="TRUE" "END" "ELSE" T:=T+H; DUPVEC(M0,M,0,C,U); DERIVATIVE(1,C); LOCALERRORCONSTRUCTION(4); OUTPUT; "END"; START:="TRUE"; LAST:="FALSE"; DUPVEC(M0,M,0,C,U); DERIVATIVE(1,C); "IF" K=0 "THEN" "BEGIN" LOCAL ERROR BOUND; HSTART:=ETA/NORMFUNCTION(NORM,C) "END"; NEXT LEVEL: DIFFERENCE SCHEME; "IF" T^=TE "THEN" "GOTO" NEXT LEVEL; ENDOFEFT: "END" EXPONENTIAL FITTED TAYLOR; "COMMENT" ================== 33012 =================; "PROCEDURE" RK2(X, A, B, Y, YA, Z, ZA, FXYZ, E, D, FI); "VALUE" B, FI; "REAL" X, A, B, Y, YA, Z, ZA, FXYZ; "BOOLEAN" FI; "ARRAY" E, D; "BEGIN" "REAL" E1, E2, E3, E4, XL, YL, ZL, H, INT, HMIN, HL, ABSH, K0, K1, K2, K3, K4, K5, DISCRY, DISCRZ, TOLY, TOLZ, MU, MU1, FHY, FHZ; "BOOLEAN" LAST, FIRST, REJECT; "IF" FI "THEN" "BEGIN" D[3]:= A; D[4]:= YA; D[5]:= ZA "END"; D[1]:= 0; XL:= D[3]; YL:= D[4]; ZL:= D[5]; "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]); "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL); HMIN:= INT * E[1] + E[2]; HL:= INT * E[3] + E[4]; "IF" HL < HMIN "THEN" HMIN:= HL; E1:= E[1] / INT; E2:= E[2] / INT; E3:= E[3] / INT; E4:= E[4] / INT; FIRST:= "TRUE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN "END"; "IF" H >= B - XL "EQUIV" H >= 0 "THEN" "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: X:= XL; Y:= YL; Z:= ZL; K0:= FXYZ * H; X:= XL + H / 4.5; Y:= YL + (ZL * 18 + K0 * 2) / 81 * H; Z:= ZL + K0 / 4.5 ; K1:= FXYZ * H; X:= XL + H / 3; Y:= YL + (ZL * 6 + K0) / 18 * H; Z:= ZL + (K0 + K1 * 3) / 12; K2:= FXYZ * H; X:= XL + H * .5; Y:= YL + (ZL * 8 + K0 + K2) / 16 * H; Z:= ZL + (K0 + K2 * 3) / 8; K3:= FXYZ * H; X:= XL + H * .8; Y:= YL + (ZL * 100 + K0 * 12 + K3 * 28) / 125 * H; Z:= ZL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56) / 125; K4:= FXYZ * H; X:= "IF" LAST "THEN" B "ELSE" XL + H; Y:= YL + (ZL * 336 + K0 * 21 + K2 * 92 + K4 * 55) / 336 * H; Z:= ZL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112 + K4 * 25) / 168; K5:= FXYZ * H; DISCRY:= ABS(( - K0 * 21 + K2 * 108 - K3 * 112 + K4 * 25) / 56 * H); DISCRZ:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 * 125 + K5 * 42) / 14; TOLY:= ABSH * (ABS(ZL) * E1 + E2); TOLZ:= ABS(K0) * E3 + ABSH * E4; REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ; FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ; "IF" FHZ > FHY "THEN" FHY:= FHZ; MU:= 1 / (1 + FHY) + .45; "IF" REJECT "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" D[1]:= D[1] + 1; Y:= YL; Z:= ZL; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H; ACC: MU1:= MU; Y:= YL + (ZL * 56 + K0 * 7 + K2 * 36 - K4 * 15) / 56 * HL; Z:= ZL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112 + K4 * 50) / 28; K5:= FXYZ * HL; Y:= YL + (ZL * 336 + K0 * 35 + K2 * 108 + K4 * 25) / 336 * HL; Z:= ZL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14) / 336; NEXT: "IF" B ^= X "THEN" "BEGIN" XL:= X; YL:= Y; ZL:= Z; "GOTO" TEST "END"; "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; D[4]:= Y; D[5]:= Z "END" RK2; "COMMENT" ================== 33013 =================; "PROCEDURE" RK2N(X, A, B, Y, YA, Z, ZA, FXYZJ, J, E, D, FI, N); "VALUE" B, FI, N; "INTEGER" J, N; "REAL" X, A, B, FXYZJ; "BOOLEAN" FI; "ARRAY" Y, YA, Z, ZA, E, D; "BEGIN" "INTEGER" JJ; "REAL" XL, H, INT, HMIN, HL, ABSH, FHM, DISCRY, DISCRZ, TOLY, TOLZ, MU, MU1, FHY, FHZ; "BOOLEAN" LAST, FIRST, REJECT; "ARRAY" YL, ZL, K0, K1, K2, K3, K4, K5[1:N], EE[1:4 * N]; "IF" FI "THEN" "BEGIN" D[3]:= A; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[JJ + 3]:= YA[JJ]; D[N + JJ + 3]:= ZA[JJ] "END" "END"; D[1]:= 0; XL:= D[3]; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YL[JJ]:= D[JJ + 3]; ZL[JJ]:= D[N + JJ + 3] "END"; "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]); "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL); HMIN:= INT * E[1] + E[2]; "FOR" JJ:= 2 "STEP" 1 "UNTIL" 2 * N "DO" "BEGIN" HL:= INT * E[2 * JJ - 1] + E[2 * JJ]; "IF" HL < HMIN "THEN" HMIN:= HL "END"; "FOR" JJ:= 1 "STEP" 1 "UNTIL" 4 * N "DO" EE[JJ]:= E[JJ] / INT; FIRST:= "TRUE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= ABS(H) "END"; "IF" H >= B - XL "EQUIV" H >= 0 "THEN" "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: X:= XL; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K0[J]:= FXYZJ * H; X:= XL + H / 4.5; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 18 + K0[JJ] * 2) / 81 * H; Z[JJ]:= ZL[JJ] + K0[JJ] / 4.5; "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= FXYZJ * H; X:= XL + H / 3; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 6 + K0[JJ]) / 18 * H; Z[JJ]:= ZL[JJ] + (K0[JJ] + K1[JJ] * 3) / 12 "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K2[J]:= FXYZJ * H; X:= XL + H * .5; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 8 + K0[JJ] + K2[JJ]) / 16 * H; Z[JJ]:= ZL[JJ] + (K0[JJ] + K2[JJ] * 3) / 8 "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K3[J]:= FXYZJ * H; X:= XL + H * .8; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 100 + K0[JJ] * 12 + K3[JJ] * 28) / 125 * H; Z[JJ]:= ZL[JJ] + (K0[JJ] * 53 - K1[JJ] * 135 + K2[JJ] * 126 + K3[JJ] * 56) / 125 "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K4[J]:= FXYZJ * H; X:= "IF" LAST "THEN" B "ELSE" XL + H; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 336 + K0[JJ] * 21 + K2[JJ] * 92 + K4[JJ] * 55) / 336 * H; Z[JJ]:= ZL[JJ] + (K0[JJ] * 133 - K1[JJ] * 378 + K2[JJ] * 276 + K3[JJ] * 112 + K4[JJ] * 25) / 168 "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYZJ * H; REJECT:= "FALSE"; FHM:= 0; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DISCRY:= ABS(( - K0[JJ] * 21 + K2[JJ] * 108 - K3[JJ] * 112 + K4[JJ] * 25) / 56 * H); DISCRZ:= ABS(K0[JJ] * 21 - K2[JJ] * 162 + K3[JJ] * 224 - K4[JJ] * 125 + K5[JJ] * 42) / 14; TOLY:= ABSH * (ABS(ZL[JJ]) * EE[2 * JJ - 1] + EE[2 * JJ]); TOLZ:= ABS(K0[JJ]) * EE[2 * (JJ + N) - 1] + ABSH * EE[2 * (JJ + N)]; REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ "OR" REJECT; FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ; "IF" FHZ > FHY "THEN" FHY:= FHZ; "IF" FHY > FHM "THEN" FHM:= FHY "END"; MU:= 1 / (1 + FHM) + .45; "IF" REJECT "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" D[1]:= D[1] + 1; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END"; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FHM:= MU * H / HL + MU - MU1; HL:= H; H:= FHM * H; ACC: MU1:= MU; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 56 + K0[JJ] * 7 + K2[JJ] * 36 - K4[JJ] * 15) / 56 * HL; Z[JJ]:= ZL[JJ] + ( - K0[JJ] * 63 + K1[JJ] * 189 - K2[JJ] * 36 - K3[JJ] * 112 + K4[JJ] * 50) / 28 "END"; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYZJ * HL; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 336 + K0[JJ] * 35 + K2[JJ] * 108 + K4[JJ] * 25) / 336 * HL; Z[JJ]:= ZL[JJ] + (K0[JJ] * 35 + K2[JJ] * 162 + K4[JJ] * 125 + K5[JJ] * 14) / 336 "END"; NEXT: "IF" B ^= X "THEN" "BEGIN" XL:= X; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YL[JJ]:= Y[JJ]; ZL[JJ]:= Z[JJ] "END"; "GOTO" TEST "END"; "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[JJ + 3]:= Y[JJ]; D[N + JJ + 3]:= Z[JJ] "END" "END" RK2N; "COMMENT" ================== 33014 =================; "PROCEDURE" RK3(X, A, B, Y, YA, Z, ZA, FXY, E, D, FI); "VALUE" B, FI; "REAL" X, A, B, Y, YA, Z, ZA, FXY; "BOOLEAN" FI; "ARRAY" E, D; "BEGIN" "REAL" E1, E2, E3, E4, XL, YL, ZL, H, INT, HMIN, HL, ABSH, K0, K1, K2, K3, K4, K5, DISCRY, DISCRZ, TOLY, TOLZ, MU, MU1, FHY, FHZ; "BOOLEAN" LAST, FIRST, REJECT; "IF" FI "THEN" "BEGIN" D[3]:= A; D[4]:= YA; D[5]:= ZA "END"; D[1]:= 0; XL:= D[3]; YL:= D[4]; ZL:= D[5]; "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]); "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL); HMIN:= INT * E[1] + E[2]; HL:= INT * E[3] + E[4]; "IF" HL < HMIN "THEN" HMIN:= HL; E1:= E[1] / INT; E2:= E[2] / INT; E3:= E[3] / INT; E4:= E[4] / INT; FIRST:= REJECT:= "TRUE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN "END"; "IF" H >= B - XL "EQUIV" H >= 0 "THEN" "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: "IF" REJECT "THEN" "BEGIN" X:= XL; Y:= YL; K0:= FXY * H "END" "ELSE" K0:= K5 * H / HL; X:= XL + .276393202250021 * H; Y:= YL + (ZL * .2763932022 50021 + K0 * .038196601125011) * H; K1:= FXY * H; X:= XL + .72360 6797749979 * H; Y:= YL + (ZL * .723606797749979 + K1 * .26180 3398874989) * H; K2:= FXY * H; X:= XL + H * .5; Y:= YL + (ZL * .5 + K0 * .046875 + K1 * .079824155839840 - K2 * .001699155839840) * H; K4:= FXY * H; X:= "IF" LAST "THEN" B "ELSE" XL + H; Y:= YL + (ZL + K0 * .309016994374947 + K2 * .190983005625053) * H; K3:= FXY * H; Y:= YL + (ZL + K0 * .083333333333333 + K1 * .301502832395825 + K2 * .115163834270842) * H; K5:= FXY * H; DISCRY:= ABS(( - K0 * .5 + K1 * 1.809016994374947 + K2 * .690983005625053 - K4 * 2) * H); DISCRZ:= ABS((K0 - K3) * 2 - (K1 + K2) * 10 + K4 * 16 + K5 * 4); TOLY:= ABSH * (ABS(ZL) * E1 + E2); TOLZ:= ABS(K0) * E3 + ABSH * E4; REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ; FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ; "IF" FHZ > FHY "THEN" FHY:= FHZ; MU:= 1 / (1 + FHY) + .45; "IF" REJECT "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" D[1]:= D[1] + 1; Y:= YL; Z:= ZL; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END"; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H; ACC: MU1:= MU; Z:= ZL + (K0 + K3) * .083333333333333 + (K1 + K2) * .416666666666667; NEXT: "IF" B ^= X "THEN" "BEGIN" XL:= X; YL:= Y; ZL:= Z; "GOTO" TEST "END"; "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; D[4]:= Y; D[5]:= Z "END" RK3; "COMMENT" ================== 33015 =================; "PROCEDURE" RK3N(X, A, B, Y, YA, Z, ZA, FXYJ, J, E, D, FI, N); "VALUE" B, FI, N; "INTEGER" J, N; "REAL" X, A, B, FXYJ; "BOOLEAN" FI; "ARRAY" Y, YA, Z, ZA, E, D; "BEGIN" "INTEGER" JJ; "REAL" XL, H, HMIN, INT, HL, ABSH, FHM, DISCRY, DISCRZ, TOLY, TOLZ, MU, MU1, FHY, FHZ; "BOOLEAN" LAST, FIRST, REJECT; "ARRAY" YL, ZL, K0, K1, K2, K3, K4, K5[1:N], EE[1:4 * N]; "IF" FI "THEN" "BEGIN" D[3]:= A; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[JJ + 3]:= YA[JJ]; D[N + JJ + 3]:= ZA[JJ] "END" "END"; D[1]:= 0; XL:= D[3]; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YL[JJ]:= D[JJ + 3]; ZL[JJ]:= D[N + JJ + 3] "END"; "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]); "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL); HMIN:= INT * E[1] + E[2]; "FOR" JJ:= 2 "STEP" 1 "UNTIL" 2 * N "DO" "BEGIN" HL:= INT * E[2 * JJ - 1] + E[2 * JJ]; "IF" HL < HMIN "THEN" HMIN:= HL "END"; "FOR" JJ:= 1 "STEP" 1 "UNTIL" 4 * N "DO" EE[JJ]:= E[JJ] / INT; FIRST:= REJECT:= "TRUE"; "IF" FI "THEN" "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END"; TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN" "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN "END"; "IF" H >= B - XL "EQUIV" H >= 0 "THEN" "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL; ABSH:= ABS(H) "END" "ELSE" LAST:= "FALSE"; STEP: "IF" REJECT "THEN" "BEGIN" X:= XL; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ]; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K0[J]:= FXYJ * H "END" "ELSE" "BEGIN" FHY:= H / HL; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" K0[JJ]:= K5[JJ] * FHY "END"; X:= XL + .27639 3202250021 * H; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ] * .276393202250021 + K0[JJ] * .038196601125011) * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= FXYJ * H; X:= XL + .723606797749979 * H; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ] * .723606797749979 + K1[JJ] * .261803398874989) * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K2[J]:= FXYJ * H; X:= XL + H * .5; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ] * .5 + K0[JJ] * .046875 + K1[JJ] * .079824155839840 - K2[JJ] * .00169 9155839840) * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K4[J]:= FXYJ * H; X:= "IF" LAST "THEN" B "ELSE" XL + H; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ] + K0[JJ] * .309016994374947 + K2[JJ] * .190983005625053) * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K3[J]:= FXYJ * H; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ] + K0[JJ] * .083333333333333 + K1[JJ] * .30150 2832395825 + K2[JJ] * .115163834270842) * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYJ * H; REJECT:= "FALSE"; FHM:= 0; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DISCRY:= ABS(( - K0[JJ] * .5 + K1[JJ] * 1.809016994374947 + K2[JJ] * .690983005625053 - K4[JJ] * 2) * H); DISCRZ:= ABS((K0[JJ] - K3[JJ]) * 2 - (K1[JJ] + K2[JJ]) * 10 + K4[JJ] * 16 + K5[JJ] * 4); TOLY:= ABSH * (ABS(ZL[JJ]) * EE[2 * JJ - 1] + EE[2 * JJ]); TOLZ:= ABS(K0[JJ]) * EE[2 * (JJ + N) - 1] + ABSH * EE[2 * (JJ + N)]; REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ "OR" REJECT; FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ; "IF" FHZ > FHY "THEN" FHY:= FHZ; "IF" FHY > FHM "THEN" FHM:= FHY "END"; MU:= 1 / (1 + FHM) + .45; "IF" REJECT "THEN" "BEGIN" "IF" ABSH <= HMIN "THEN" "BEGIN" D[1]:= D[1] + 1; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END"; FIRST:= "TRUE"; "GOTO" NEXT "END"; H:= MU * H; "GOTO" TEST "END" REJ; "IF" FIRST "THEN" "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC "END"; FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H; ACC: MU1:= MU; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Z[JJ]:= ZL[JJ] + (K0[JJ] + K3[JJ]) * .083333333333333 + (K1[JJ] + K2[JJ]) * .416666666666667; NEXT: "IF" B ^= X "THEN" "BEGIN" XL:= X; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" YL[JJ]:= Y[JJ]; ZL[JJ]:= Z[JJ] "END"; "GOTO" TEST "END"; "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" D[JJ + 3]:= Y[JJ]; D[N + JJ + 3]:= Z[JJ] "END" "END" RK3N; "COMMENT" ================== 35120 =================; "REAL" "PROCEDURE" TAN(X); "VALUE" X; "REAL" X; "BEGIN" "REAL" U; "BOOLEAN" "PROCEDURE" OVERFLOW(X); "CODE" 30009; "REAL" "PROCEDURE" GIANT; "CODE" 30004; U:= SIN(X)/COS(X); TAN:= "IF" OVERFLOW(U) "THEN" GIANT "ELSE" U "END" TAN; "COMMENT" ================== 35111 =================; "REAL" "PROCEDURE" SINH(X); "VALUE" X; "REAL" X; "BEGIN" "REAL" AX,Y; AX:= ABS(X); "IF" AX < 0.3 "THEN" "BEGIN" Y:= "IF" AX < 0.1 "THEN" X*X "ELSE" X*X/9; X:= ((( 0.0001984540 * Y + 0.0083333331783 )* Y + 0.16666666666675)* Y + 1.0 )* X ; SINH:= "IF" AX < 0.1 "THEN" X "ELSE" X * ( 1.0 + 0.14814814814815 * X * X ) "END" "ELSE" "IF" AX < 17.5 "THEN" "BEGIN" AX:= EXP( AX ); SINH:= SIGN(X) * .5 * ( AX -1/AX ) "END" "ELSE" "IF" AX > 742.36063037970 "THEN" "BEGIN" "REAL" "PROCEDURE" GIANT; "CODE" 30004; SINH:= SIGN(X)*GIANT "END" "ELSE" SINH:= SIGN(X)*EXP(AX- .69314 71805 59945) "END" SINH; "COMMENT" ================== 35115 =================; "REAL" "PROCEDURE" ARCCOSH(X); "VALUE" X; "REAL" X; ARCCOSH:= "IF" X <= 1 "THEN" 0 "ELSE" "IF" X > "10 "THEN" 0.69314718055995 + LN(X) "ELSE" LN(X+SQRT((X-1)*(X+1))); "COMMENT" ================== 35080 =================; "REAL" "PROCEDURE" EI(X);"VALUE" X;"REAL" X; "BEGIN" "REAL" "ARRAY" P,Q[0:7]; "REAL" "PROCEDURE" CHEPOLSER(N,X,A);"CODE" 31046; "REAL" "PROCEDURE" POL(N,X,A);"CODE" 31040; "REAL" "PROCEDURE" JFRAC(N,A,B);"CODE" 35083; "IF" X>24 "THEN" "BEGIN" P[0]:= +1.00000000000058 ;Q[1]:= 1.99999999924131 ; P[1]:=X-3.00000016782085 ;Q[2]:=-2.99996432944446 ; P[2]:=X-5.00140345515924 ;Q[3]:=-7.90404992298926 ; P[3]:=X-7.49289167792884 ;Q[4]:=-4.31325836146628 ; P[4]:=X-3.08336269051763"+1;Q[5]:= 2.95999399486831"+2; P[5]:=X-1.39381360364405 ;Q[6]:=-6.74704580465832 ; P[6]:=X+8.91263822573708 ;Q[7]:= 1.04745362652468"+3; P[7]:=X-5.31686623494482"+1; EI:=EXP(X)*(1+JFRAC(7,Q,P)/X)/X "END" "ELSE" "IF" X>12 "THEN" "BEGIN" P[0]:= +9.99994296074708"-1;Q[1]:= 1.00083867402639 ; P[1]:=X-1.95022321289660 ;Q[2]:=-3.43942266899870 ; P[2]:=X+1.75656315469614 ;Q[3]:= 2.89516727925135"+1; P[3]:=X+1.79601688769252"+1;Q[4]:= 7.60761148007735"+2; P[4]:=X-3.23467330305403"+1;Q[5]:= 2.57776384238440"+1; P[5]:=X-8.28561994140641 ;Q[6]:= 5.72837193837324"+1; P[6]:=X-1.86545454883399"+1;Q[7]:= 6.95000655887434"+1; P[7]:=X-3.48334653602853 ; EI:=EXP(X)*JFRAC(7,Q,P)/X "END" "ELSE" "IF" X>6 "THEN" "BEGIN" P[0]:= +1.00443109228078 ;Q[1]:= 5.27468851962908"-1; P[1]:=X-4.32531132878135"+1;Q[2]:= 2.73624119889328"+3; P[2]:=X+6.01217990830080"+1;Q[3]:= 1.43256738121938"+1; P[3]:=X-3.31842531997221"+1;Q[4]:= 1.00367439516726"+3; P[4]:=X+2.50762811293560"+1;Q[5]:=-6.25041161671876 ; P[5]:=X+9.30816385662165 ;Q[6]:= 3.00892648372915"+2; P[6]:=X-2.19010233854880"+1;Q[7]:= 3.93707701852715 ; P[7]:=X-2.18086381520724 ; EI:=EXP(X)*JFRAC(7,Q,P)/X "END" "ELSE" "IF" X>0 "THEN" "BEGIN" "REAL" T,R,X0,XMX0; P[0]:=-1.95773036904548"+8;Q[0]:=-8.26271498626055"+7; P[1]:= 3.89280421311201"+6;Q[1]:= 8.91925767575612"+7; P[2]:=-2.21744627758845"+7;Q[2]:=-2.49033375740540"+7; P[3]:=-1.19623669349247"+5;Q[3]:= 4.28559624611749"+6; P[4]:=-2.49301393458648"+5;Q[4]:=-4.83547436162164"+5; P[5]:=-4.21001615357070"+3;Q[5]:= 3.57300298058508"+4; P[6]:=-5.49142265521085"+2;Q[6]:=-1.60708926587221"+3; P[7]:=-8.66937339951070 ;Q[7]:= 3.41718750000000"+1; X0:=.372507410781367; T:=X/3-1; R:=CHEPOLSER(7,T,P)/CHEPOLSER(7,T,Q); XMX0:=(X-409576229586/1099511627776)-.767177250199394"-12; "IF" ABS(XMX0)>.037 "THEN" T:=LN(X/X0) "ELSE" "BEGIN" "REAL" Z,Z2; P[0]:= .837207933976075"+1;Q[0]:= .418603966988037"+1; P[1]:=-.652268740837103"+1;Q[1]:=-.465669026080814"+1; P[2]:= .569955700306720 ;Q[2]:= .1"+1; Z:=XMX0/(X+X0);Z2:=Z*Z; T:=Z*POL(2,Z2,P)/POL(2,Z2,Q) "END"; EI:=T+XMX0*R "END" "ELSE" "IF" X>-1 "THEN" "BEGIN" "REAL" Y; P[0]:=-4.41785471728217"+4;Q[0]:= 7.65373323337614"+4; P[1]:= 5.77217247139444"+4;Q[1]:= 3.25971881290275"+4; P[2]:= 9.93831388962037"+3;Q[2]:= 6.10610794245759"+3; P[3]:= 1.84211088668000"+3;Q[3]:= 6.35419418378382"+2; P[4]:= 1.01093806161906"+2;Q[4]:= 3.72298352833327"+1; P[5]:= 5.03416184097568 ;Q[5]:= 1; Y:=-X; EI:=LN(Y)-POL(5,Y,P)/POL(5,Y,Q) "END" "ELSE" "IF" X>-4 "THEN" "BEGIN" "REAL" Y; P[0]:= 8.67745954838444"-8;Q[0]:= 1; P[1]:= 9.99995519301390"-1;Q[1]:= 1.28481935379157"+1; P[2]:= 1.18483105554946"+1;Q[2]:= 5.64433569561803"+1; P[3]:= 4.55930644253390"+1;Q[3]:= 1.06645183769914"+2; P[4]:= 6.99279451291003"+1;Q[4]:= 8.97311097125290"+1; P[5]:= 4.25202034768841"+1;Q[5]:= 3.14971849170441"+1; P[6]:= 8.83671808803844 ;Q[6]:= 3.79559003762122 ; P[7]:= 4.01377664940665"-1;Q[7]:= 9.08804569188869"-2; Y:=-1/X; EI:=-EXP(X)*POL(7,Y,P)/POL(7,Y,Q) "END" "ELSE" "BEGIN" "REAL" Y; P[0]:=-9.99999999998447"-1;Q[0]:= 1; P[1]:=-2.66271060431811"+1;Q[1]:= 2.86271060422192"+1; P[2]:=-2.41055827097015"+2;Q[2]:= 2.92310039388533"+2; P[3]:=-8.95927957772937"+2;Q[3]:= 1.33278537748257"+3; P[4]:=-1.29885688746484"+3;Q[4]:= 2.77761949509163"+3; P[5]:=-5.45374158883133"+2;Q[5]:= 2.40401713225909"+3; P[6]:=-5.66575206533869 ;Q[6]:= 6.31657483280800"+2; Y:=-1/X; EI:=-EXP(X)*Y*(1+Y*POL(6,Y,P)/POL(6,Y,Q)) "END" "END" EI; "COMMENT" ================== 35086 =================; "PROCEDURE" ENX(X, N1, N2, A); "VALUE" X, N1, N2; "REAL" X; "INTEGER" N1, N2; "ARRAY" A; "IF" X<= 1.5 "THEN" "BEGIN" "REAL" "PROCEDURE" EI(X); "CODE" 35080; "REAL" W, E; "INTEGER" I; W:= -EI(-X); "IF" N1=1 "THEN" A[1]:=W; "IF" N2>1 "THEN" E:= EXP(-X); "FOR" I:=2 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" W:= (E - X * W)/(I - 1); "IF" I>= N1 "THEN" A[I]:=W "END" "END" "ELSE" "BEGIN" "INTEGER" I, N; "REAL" W, E, AN; N:=ENTIER(X+.5); "IF" N<=10 "THEN" "BEGIN" "REAL" F, W1, T, H; "REAL" "ARRAY" P[2:19]; P[ 2]:=.37534261820491"-1; P[11]:=.135335283236613 ; P[ 3]:=.89306465560228"-2; P[12]:=.497870683678639"-1; P[ 4]:=.24233983686581"-2; P[13]:=.183156388887342"-1; P[ 5]:=.70576069342458"-3; P[14]:=.673794699908547"-2; P[ 6]:=.21480277819013"-3; P[15]:=.247875217666636"-2; P[ 7]:=.67375807781018"-4; P[16]:=.911881965554516"-3; P[ 8]:=.21600730159975"-4; P[17]:=.335462627902512"-3; P[ 9]:=.70411579854292"-5; P[18]:=.123409804086680"-3; P[10]:=.23253026570282"-5; P[19]:=.453999297624848"-4; F:= W:= P[N]; E:= P[N+9]; W1:= T:= 1; H:= X-N; "FOR" I:=N-1, I-1 "WHILE" ABS(W1)>"-15 * W "DO" "BEGIN" F:= (E - I * F)/N; T:= -H * T / (N-I); W1:= T * F; W:= W + W1 "END" "END" "ELSE" "BEGIN" "PROCEDURE" NONEXPENX(X, N1, N2, A); "CODE" 35087; "ARRAY" B[N:N]; NONEXPENX(X, N, N, B); W:= B[N] * EXP(-X) "END"; "IF" N1=N2 & N1=N "THEN" A[N]:=W "ELSE" "BEGIN" E:= EXP(-X); AN:=W; "IF" N<=N2 & N>=N1 "THEN" A[N]:=W; "FOR" I:= N-1 "STEP" -1 "UNTIL" N1 "DO" "BEGIN" W:= (E - I * W)/X; "IF" I<= N2 "THEN" A[I]:= W "END"; W:=AN; "FOR" I:=N+1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" W:= (E - X * W)/(I - 1); "IF" I>=N1 "THEN" A[I]:=W "END" "END" "END" ENX; "COMMENT" ================== 35087 =================; "PROCEDURE" NONEXPENX(X, N1, N2, A); "VALUE" X, N1, N2; "REAL" X; "INTEGER" N1, N2; "ARRAY" A; "BEGIN" "INTEGER" I, N; "REAL" W, AN; N:= "IF" X<=1.5 "THEN" 1 "ELSE" ENTIER(X+.5); "IF" N<=10 "THEN" "BEGIN" "PROCEDURE" ENX(X, N1, N2, A); "CODE" 35086; "ARRAY" B[N:N]; ENX(X, N, N, B); W:= B[N] * EXP(X) "END" "ELSE" "BEGIN" "INTEGER" K, K1; "REAL" UE, VE, WE, WE1, UO, VO, WO, WO1, R, S; UE:=1; VE:= WE:= 1/(X+N); WE1:=0; UO:=1; VO:= -N/(X * (X + N + 1)); WO1:= 1/X; WO:= VO + WO1; W:= (WE + WO)/2; K1:=1; "FOR" K:=K1 "WHILE" WO-WE>"-15 * W & WE>WE1 & WO=N1 "THEN" A[N]:=W; "FOR" I:= N-1 "STEP" -1 "UNTIL" N1 "DO" "BEGIN" W:= (1 - I * W)/X; "IF" I<= N2 "THEN" A[I]:=W "END"; W:=AN; "FOR" I:= N+1 "STEP" 1 "UNTIL" N2 "DO" "BEGIN" W:= (1 - X * W)/(I - 1); "IF" I>=N1 "THEN" A[I]:=W "END" "END" EXPENX; "COMMENT" ================== 35084 =================; "PROCEDURE" SINCOSINT(X,SI,CI); "VALUE" X; "REAL" X,SI,CI; "BEGIN" "REAL" ABSX,Z,F,G; "PROCEDURE" SINCOSFG(X,F,G); "CODE" 35085; "REAL" "PROCEDURE" CHEPOLSER(N,X,A); "CODE" 31046; ABSX:= ABS(X); "IF" ABSX <= 4 "THEN" "BEGIN" "REAL" "ARRAY" A[0:10]; "REAL" Z2; A[0] :=+2.7368706803630"+00; A[1]:=-1.1106314107894"+00; A[2] :=+1.4176562194666"-01; A[3]:=-1.0252652579174"-02; A[4] :=+4.6494615619880"-04; A[5]:=-1.4361730896642"-05; A[6] :=+3.2093684948229"-07; A[7]:=-5.4251990770162"-09; A[8] :=+7.1776288639895"-11; A[9]:=-7.6335493723482"-13; A[10]:=+6.6679958346983"-15; Z:= X / 4; Z2:= Z * Z; G:= Z2 +Z2 - 1; SI:= Z * CHEPOLSER(10,G,A); A[0] :=+2.9659601400727"+00; A[1]:=-9.4297198341830"-01; A[2] :=+8.6110342738169"-02; A[3]:=-4.7776084547139"-03; A[4] :=+1.7529161205146"-04; A[5]:=-4.5448727803752"-06; A[6] :=+8.7515839180060"-08; A[7]:=-1.2998699938109"-09; A[8] :=+1.5338974898831"-11; A[9]:=-1.4724256070277"-13; A[10]:=+1.1721420798429"-15; CI:= .577215664901533 + LN(ABSX) - Z2 * CHEPOLSER(10,G,A) "END" "ELSE" "BEGIN" "REAL" CX,SX; SINCOSFG(X,F,G); CX:= COS(X); SX:= SIN(X); SI:= 1.570796326794897; "IF" X<0 "THEN" SI:= -SI; SI:= SI - F * CX - G * SX; CI:= F * SX - G * CX "END" "END" SINCOSINT; "COMMENT" ================== 35085 =================; "PROCEDURE" SINCOSFG(X,F,G); "VALUE" X; "REAL" X,F,G; "BEGIN" "REAL" ABSX,SI,CI; "PROCEDURE" SINCOSINT(X,SI,CI); "CODE" 35084; "REAL" "PROCEDURE" CHEPOLSER(N,X,A); "CODE" 31046; ABSX:= ABS(X); "IF" ABSX <= 4 "THEN" "BEGIN" "REAL" CX,SX; SINCOSINT(X,SI,CI); CX:= COS(X); SX:= SIN(X); SI:= SI - 1.570796326794897; F:= CI * SX - SI * CX; G:=-CI * CX - SI * SX "END" "ELSE" "BEGIN" "REAL" "ARRAY" A[0:23]; A[0] :=+9.6578828035185"-01; A[1] :=-4.3060837778597"-02; A[2] :=-7.3143711748104"-03; A[3] :=+1.4705235789868"-03; A[4] :=-9.8657685732702"-05; A[5] :=-2.2743202204655"-05; A[6] :=+9.8240257322526"-06; A[7] :=-1.8973430148713"-06; A[8] :=+1.0063435941558"-07; A[9] :=+8.0819364822241"-08; A[10]:=-3.8976282875288"-08; A[11]:=+1.0335650325497"-08; A[12]:=-1.4104344875897"-09; A[13]:=-2.5232078399683"-10; A[14]:=+2.5699831325961"-10; A[15]:=-1.0597889253948"-10; A[16]:=+2.8970031570214"-11; A[17]:=-4.1023142563083"-12; A[18]:=-1.0437693730018"-12; A[19]:=+1.0994184520547"-12; A[20]:=-5.2214239401679"-13; A[21]:=+1.7469920787829"-13; A[22]:=-3.8470012979279"-14; F:= CHEPOLSER(22, 8/ABSX-1, A) / X; A[0] :=+2.2801220638241"-01; A[1] :=-2.6869727411097"-02; A[2] :=-3.5107157280958"-03; A[3] :=+1.2398008635186"-03; A[4] :=-1.5672945116862"-04; A[5] :=-1.0664141798094"-05; A[6] :=+1.1170629343574"-05; A[7] :=-3.1754011655614"-06; A[8] :=+4.4317473520398"-07; A[9] :=+5.5108696874463"-08; A[10]:=-5.9243078711743"-08; A[11]:=+2.2102573381555"-08; A[12]:=-5.0256827540623"-09; A[13]:=+3.1519168259424"-10; A[14]:=+3.6306990848979"-10; A[15]:=-2.2974764234591"-10; A[16]:=+8.5530309424048"-11; A[17]:=-2.1183067724443"-11; A[18]:=+1.7133662645092"-12; A[19]:=+1.7238877517248"-12; A[20]:=-1.2930281366811"-12; A[21]:=+5.7472339223731"-13; A[22]:=-1.8415468268314"-13; A[23]:=+3.5937256571434"-14; G:= 4 * CHEPOLSER(23, 8/ABSX-1, A) / ABSX /ABSX "END" "END" SINCOSFG; "COMMENT" ================== 35060 =================; "REAL" "PROCEDURE" RECIP GAMMA(X, ODD, EVEN); "VALUE" X; "REAL" X, ODD, EVEN; "BEGIN" "INTEGER" I; "REAL" ALFA, BETA, X2; "ARRAY" B[1:12]; B[ 1]:= -.28387 65422 76024; B[ 2]:= -.07685 28408 44786; B[ 3]:= +.00170 63050 71096; B[ 4]:= +.00127 19271 36655; B[ 5]:= +.00007 63095 97586; B[ 6]:= -.00000 49717 36704; B[ 7]:= -.00000 08659 20800; B[ 8]:= -.00000 00331 26120; B[ 9]:= +.00000 00017 45136; B[10]:= +.00000 00002 42310; B[11]:= +.00000 00000 09161; B[12]:= -.00000 00000 00170; X2:= X * X * 8; ALFA:= -.00000 00000 00001; BETA:= 0; "FOR" I:= 12 "STEP" - 2 "UNTIL" 2 "DO" "BEGIN" BETA:= -(ALFA * 2 + BETA); ALFA:= - BETA * X2 - ALFA + B[I] "END"; EVEN:= (BETA / 2 + ALFA) * X2 - ALFA + .92187 02936 50453; ALFA:= -.00000 00000 00034; BETA:= 0; "FOR" I:= 11 "STEP" - 2 "UNTIL" 1 "DO" "BEGIN" BETA:= -(ALFA * 2 + BETA); ALFA:= - BETA * X2 - ALFA + B[I] "END"; ODD:= (ALFA + BETA) * 2; RECIP GAMMA:= ODD * X + EVEN "END" RECIP GAMMA; "COMMENT" ================== 35061 =================; "REAL" "PROCEDURE" GAMMA(X); "VALUE" X; "REAL" X; "BEGIN" "REAL" Y, S, F, G, ODD, EVEN; "BOOLEAN" INV; "REAL" "PROCEDURE" RECIP GAMMA(X, ODD, EVEN); "VALUE" X; "REAL" X, ODD, EVEN; "CODE" 35060; "REAL" "PROCEDURE" LOG GAMMA(X); "VALUE" X; "REAL" X; "CODE" 35062; "IF" X < .5 "THEN" "BEGIN" Y:= X - ENTIER(X / 2) * 2; S:= 3.14159 26535 8979; "IF" Y >= 1 "THEN" "BEGIN" S:= - S; Y:= 2 - Y "END"; "IF" Y >= .5 "THEN" Y:= 1 - Y; INV:= "TRUE"; X:= 1 - X; F:= S / SIN(3.14159 26535 8979 * Y) "END" "ELSE" INV:= "FALSE"; "IF" X > 22 "THEN" G:= EXP(LOG GAMMA(X)) "ELSE" "BEGIN" S:= 1; NEXT: "IF" X > 1.5 "THEN" "BEGIN" X:= X - 1; S:= S * X; "GOTO" NEXT "END"; G:= S / RECIP GAMMA(1 - X, ODD, EVEN) "END"; GAMMA:= "IF" INV "THEN" F / G "ELSE" G "END" GAMMA; "COMMENT" ================== 35062 =================; "REAL" "PROCEDURE" LOG GAMMA(X); "VALUE" X; "REAL" X; "IF" X > 13 "THEN" "BEGIN" "REAL" R, X2; R:= 1; NEXT: "IF" X <= 22 "THEN" "BEGIN" R:= R / X; X:= X + 1; "GOTO" NEXT "END"; X2:= - 1 / (X * X); R:= LN(R); LOG GAMMA:= LN(X) * (X - .5) - X + R + .91893 85332 04672 + (((.59523 80952 38095"-3 * X2 + .79365 07936 50794"-3) * X2 + .27777 77777 77778"-2) * X2 + .83333 33333 33333"-1) / X "END" "ELSE" "BEGIN" "REAL" Y, F, U0, U1, U, Z; "INTEGER" I; "ARRAY" B[1:18]; F:= 1; U0:= U1:= 0; B[ 1]:= -.07611 41616 704358; B[ 2]:= +.00843 23249 659328; B[ 3]:= -.00107 94937 263286; B[ 4]:= +.00014 90074 800369; B[ 5]:= -.00002 15123 998886; B[ 6]:= +.00000 31979 329861; B[ 7]:= -.00000 04851 693012; B[ 8]:= +.00000 00747 148782; B[ 9]:= -.00000 00116 382967; B[10]:= +.00000 00018 294004; B[11]:= -.00000 00002 896918; B[12]:= +.00000 00000 461570; B[13]:= -.00000 00000 073928; B[14]:= +.00000 00000 011894; B[15]:= -.00000 00000 001921; B[16]:= +.00000 00000 000311; B[17]:= -.00000 00000 000051; B[18]:= +.00000 00000 000008; "IF" X < 1 "THEN" "BEGIN" F:= 1 / X; X:= X + 1 "END" "ELSE" NEXT: "IF" X > 2 "THEN" "BEGIN" X:= X - 1; F:= F * X; "GOTO" NEXT "END"; F:= LN(F); Y:= X + X - 3; Z:= Y + Y; "FOR" I:= 18 "STEP" - 1 "UNTIL" 1 "DO" "BEGIN" U:= U0; U0:= Z * U0 + B[I] - U1; U1:= U "END"; LOG GAMMA:= (U0 * Y + .49141 53930 29387 - U1) * (X - 1) * (X - 2) + F "END" LOG GAMMA; "COMMENT" ================== 35030 =================; "PROCEDURE" INCOMGAM(X,A,KLGAM,GRGAM,GAM,EPS); "VALUE" X,A,EPS; "REAL" X,A,KLGAM,GRGAM,GAM,EPS; "BEGIN" "REAL" C0,C1,C2,D0,D1,D2,X2,AX,P,Q,R,S,R1,R2,SCF; "INTEGER" N; S:= EXP(-X + A * LN(X)); SCF:= "+300; "IF" X <= ("IF" A < 3 "THEN" 1 "ELSE" A) "THEN" "BEGIN" X2:= X * X; AX:= A * X; D0:= 1; P:= A; C0:= S; D1:=(A+1)*(A+2-X); C1:=((A+1) * (A+2)+X) * S; R2:= C1/D1; "FOR" N:= 1, N+1 "WHILE" ABS((R2-R1)/R2) > EPS "DO" "BEGIN" P:= 2+P; Q:= (P+1) * (P*(P+2)-AX); R:= N * (N+A) * (P+2) * X2; C2:= (Q*C1 + R*C0)/P; D2:= (Q*D1 + R*D0)/P; R1:=R2; R2:=C2/D2; C0:=C1; C1:=C2; D0:=D1; D1:=D2; "IF" ABS(C1) > SCF "OR" ABS(D1) > SCF "THEN" "BEGIN" C0:= C0/SCF; C1:= C1/SCF; D0:= D0/SCF; D1:= D1/SCF "END" "END"; KLGAM:= R2/A; GRGAM:= GAM - KLGAM "END" "ELSE" "BEGIN" C0:=A*S; C1:=(1+X)* C0; Q:= X +2 - A; D0:= X; D1:= X * Q; R2:= C1/D1; "FOR" N:=1, N+1 "WHILE" ABS((R2-R1)/R2)>EPS "DO" "BEGIN" Q:= 2 + Q; R:= N * (N+1-A); C2:= Q*C1-R*C0; D2:= Q*D1-R*D0; R1:=R2; R2:=C2/D2; C0:=C1; C1:=C2; D0:=D1; D1:=D2; "IF" ABS(C1) > SCF "OR" ABS(D1) > SCF "THEN" "BEGIN" C0:= C0/SCF; C1:= C1/SCF; D0:= D0/SCF; D1:= D1/SCF "END" "END"; GRGAM:= R2/A; KLGAM:= GAM - GRGAM "END" "END" INCOMGAM; "COMMENT" ================== 35050 =================; "REAL" "PROCEDURE" INCBETA(X,P,Q,EPS); "VALUE" X,P,Q,EPS; "REAL" X,P,Q,EPS; "BEGIN" "INTEGER" M,N; "REAL" G,F,FN,FN1,FN2,GN,GN1,GN2,DN,PQ; "BOOLEAN" N EVEN,RECUR; "REAL" "PROCEDURE" GAMMA(X); "VALUE" X; "REAL" X; "CODE" 35061; "IF" X=0 "OR" X=1 "THEN" INCBETA:= X "ELSE" "BEGIN" "IF" X>.5 "THEN" "BEGIN" F:= P; P:= Q; Q:= F; X:= 1-X; RECUR:= "TRUE""END" "ELSE" RECUR:= "FALSE"; G:= FN2:= 0; M:= 0; PQ:= P+Q; F:= FN1:= GN1:= GN2:= 1; N EVEN:= "FALSE"; "FOR" N:= 1,N+1 "WHILE" ABS((F-G)/F) > EPS "DO" "BEGIN" "IF" N EVEN "THEN" "BEGIN" M:= M+1; DN:= M*X*(Q-M)/(P+N-1)/(P+N) "END" "ELSE" DN:= -X*(P+M)*(PQ+M)/(P+N-1)/(P+N); G:= F; FN:= FN1+DN*FN2; GN:= GN1+DN*GN2; N EVEN:= ^ N EVEN; F:= FN/GN; FN2:= FN1; FN1:= FN; GN2:= GN1; GN1:= GN "END"; F:= F*X**P*(1-X)**Q*GAMMA(P+Q)/GAMMA(P+1)/GAMMA(Q); "IF" RECUR "THEN" F:= 1-F; INCBETA:= F "END" "END" INCBETA; "COMMENT" ================== 35051 =================; "PROCEDURE" IBPPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I; "BEGIN" "INTEGER" N; "PROCEDURE" IXQFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "CODE" 35053; "PROCEDURE" IXPFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "CODE" 35054; "IF" X=0 "OR" X=1 "THEN" "BEGIN" "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= X "END" "ELSE" "BEGIN" "IF" X <=.5 "THEN" IXQFIX(X,P,Q,NMAX,EPS,I) "ELSE" "BEGIN" IXPFIX(1-X,Q,P,NMAX,EPS,I); "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= 1-I[N] "END" "END" "END" IBPPLUSN; "COMMENT" ================== 35052 =================; "PROCEDURE" IBQPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I; "BEGIN" "INTEGER" N; "PROCEDURE" IXQFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "CODE" 35053; "PROCEDURE" IXPFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "CODE" 35054; "IF" X=0 "OR" X=1 "THEN" "BEGIN" "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= X "END" "ELSE" "BEGIN" "IF" X <=.5 "THEN" IXPFIX(X,P,Q,NMAX,EPS,I) "ELSE" "BEGIN" IXQFIX(1-X,Q,P,NMAX,EPS,I); "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= 1-I[N] "END" "END" "END" IBQPLUSN; "COMMENT" ================== 35053 =================; "PROCEDURE" IXQFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "BEGIN" "INTEGER" M,MMAX; "REAL" S,IQ0,IQ1,Q0; "REAL" "PROCEDURE" INCBETA(X,P,Q,EPS); "VALUE" X,P,Q,EPS; "REAL" X,P,Q,EPS; "CODE" 35050; "PROCEDURE" FORWARD(X,P,Q,I0,I1,NMAX,I); "VALUE" X,P,Q,I0,I1,NMAX; "INTEGER" NMAX; "REAL" X,P,Q,I0,I1; "ARRAY" I; "CODE" 35055; "PROCEDURE" BACKWARD(X,P,Q,I0,NMAX,EPS,I); "VALUE" X,P,Q,I0,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,I0,EPS; "ARRAY" I; "CODE" 35056; M:= ENTIER(Q); S:= Q-M; Q0:= "IF" S>0 "THEN" S "ELSE" S+1; MMAX:= "IF" S>0 "THEN" M "ELSE" M-1; IQ0:= INCBETA(X,P,Q0,EPS); "IF" MMAX>0 "THEN" IQ1:= INCBETA(X,P,Q0+1,EPS); "BEGIN" "ARRAY" IQ[0:MMAX]; FORWARD(X,P,Q0,IQ0,IQ1,MMAX,IQ); BACKWARD(X,P,Q,IQ[MMAX],NMAX,EPS,I) "END" "END" IXQFIX; "COMMENT" ================== 35054 =================; "PROCEDURE" IXPFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS; "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I; "BEGIN" "INTEGER" M,MMAX; "REAL" S,P0,I0,I1,IQ0,IQ1; "REAL" "PROCEDURE" INCBETA(X,P,Q,EPS); "VALUE" X,P,Q,EPS; "REAL" X,P,Q,EPS; "CODE" 35050; "PROCEDURE" FORWARD(X,P,Q,I0,I1,NMAX,I); "VALUE" X,P,Q,I0,I1,NMAX; "INTEGER" NMAX; "REAL" X,P,Q,I0,I1; "ARRAY" I; "CODE" 35055; "PROCEDURE" BACKWARD(X,P,Q,I0,NMAX,EPS,I); "VALUE" X,P,Q,I0,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,I0,EPS; "ARRAY" I; "CODE" 35056; M:= ENTIER(P); S:= P-M; P0:= "IF" S>0 "THEN" S "ELSE" S+1; MMAX:= "IF" S>0 "THEN" M "ELSE" M-1; I0:= INCBETA(X,P0,Q,EPS); I1:= INCBETA(X,P0,Q+1,EPS); "BEGIN" "ARRAY" IP[0:MMAX]; BACKWARD(X,P0,Q,I0,MMAX,EPS,IP); IQ0:= IP[MMAX]; BACKWARD(X,P0,Q+1,I1,MMAX,EPS,IP); IQ1:= IP[MMAX] "END"; FORWARD(X,P,Q,IQ0,IQ1,NMAX,I) "END" IXPFIX; "COMMENT" ================== 35055 =================; "PROCEDURE" FORWARD(X,P,Q,I0,I1,NMAX,I); "VALUE" X,P,Q,I0,I1,NMAX; "INTEGER" NMAX; "REAL" X,P,Q,I0,I1; "ARRAY" I; "BEGIN" "INTEGER" M,N; "REAL" Y,R,S; I[0]:= I0; "IF" NMAX > 0 "THEN" I[1]:= I1; M:= NMAX-1; R:= P+Q-1; Y:= 1-X; "FOR" N:= 1 "STEP" 1 "UNTIL" M "DO" "BEGIN" S:= (N+R)*Y; I[N+1]:= ((N+Q+S)*I[N]-S*I[N-1])/(N+Q) "END" "END" FORWARD; "COMMENT" ================== 35056 =================; "PROCEDURE" BACKWARD(X,P,Q,I0,NMAX,EPS,I); "VALUE" X,P,Q,I0,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,I0,EPS; "ARRAY" I; "BEGIN" "INTEGER" M,N,NU; "REAL" R,PQ,Y,LOGX; "ARRAY" IAPPROX[0:NMAX]; I[0]:= I0; "IF" NMAX>0 "THEN" "BEGIN""FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO" IAPPROX[N]:= 0; PQ:= P+Q-1; LOGX:= LN(X); R:= NMAX+(LN(EPS)+Q*LN(NMAX))/LOGX; NU:= ENTIER(R-Q*LN(R)/LOGX); L1: N:= NU; R:= X; L2: Y:= (N+PQ)*X; R:= Y/(Y+(N+P)*(1-R)); "IF" N<= NMAX "THEN" I[N]:= R; N:= N-1; "IF" N >= 1 "THEN" "GOTO" L2; R:= I0; "FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO" R:= I[N]:= I[N]*R; "FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO" "IF" ABS((I[N]-IAPPROX[N])/I[N]) > EPS "THEN" "BEGIN" "FOR" M:= 1 "STEP" 1 "UNTIL" NMAX "DO" IAPPROX[M]:= I[M]; NU:= NU+5; "GOTO" L1 "END" "END" "END" BACKWARD; "COMMENT" ================== 34150 =================; "BOOLEAN" "PROCEDURE" ZEROIN(X, Y, FX, TOLX); "REAL" X, Y, FX, TOLX; "BEGIN" "INTEGER" EXT; "REAL" C, FC, B, FB, A, FA, D, FD, FDB, FDA, W, MB, TOL, M, P, Q, DW; DW:= DWARF; B:= X; FB:= FX; A:= X:= Y; FA:= FX; INTERPOLATE: C:= A; FC:= FA; EXT:= 0; EXTRAPOLATE: "IF" ABS(FC) < ABS(FB) "THEN" "BEGIN" "IF" C ^= A "THEN" "BEGIN" D:= A; FD:= FA "END"; A:= B; FA:= FB; B:= X:= C; FB:= FC; C:= A; FC:= FA "END" INTERCHANGE; TOL:= TOLX; M:= (C + B) * 0.5; MB:= M - B; "IF" ABS(MB) > TOL "THEN" "BEGIN" "IF" EXT > 2 "THEN" W:= MB "ELSE" "BEGIN" TOL:= TOL * SIGN(MB); P:= (B - A) * FB; "IF" EXT <= 1 "THEN" Q:= FA - FB "ELSE" "BEGIN" FDB:= (FD - FB) / (D - B); FDA:= (FD - FA) / (D - A); P:= FDA * P; Q:= FDB * FA - FDA * FB "END"; "IF" P < 0 "THEN" "BEGIN" P:= -P; Q:= -Q "END"; W:= "IF" P < DW "OR" P <= Q * TOL "THEN" TOL "ELSE" "IF" P < MB * Q "THEN" P / Q "ELSE" MB "END"; D:= A; FD:= FA; A:= B; FA:= FB; X:= B:= B + W; FB:= FX; "IF" ("IF" FC >= 0 "THEN" FB >= 0 "ELSE" FB <= 0) "THEN" "GOTO" INTERPOLATE "ELSE" "BEGIN" EXT:= "IF" W = MB "THEN" 0 "ELSE" EXT + 1; "GOTO" EXTRAPOLATE "END" "END"; Y:= C; ZEROIN:= "IF" FC >= 0 "THEN" FB <= 0 "ELSE" FB >= 0 "END" ZEROIN; "COMMENT" ================== 34440 =================; "PROCEDURE" MARQUARDT(M,N,PAR,G,V,FUNCT,JACOBIAN,IN,OUT); "VALUE" M,N; "INTEGER" M,N; "ARRAY" PAR,G,V,IN,OUT; "BOOLEAN" "PROCEDURE" FUNCT; "PROCEDURE" JACOBIAN; "BEGIN" "INTEGER" MAXFE,FE,IT,I,J,ERR; "REAL" VV,WW,W,MU,RES,FPAR,FPARPRES,LAMBDA,LAMBDAMIN, P,PW,RELTOLRES,ABSTOLRES; "ARRAY" EM[0:7],VAL,B,BB,PARPRES[1:N],JAC[1:M,1:N]; "PROCEDURE" MULCOL(L,U,S,T,A,B,X); "CODE" 31022; "PROCEDURE" DUPVEC(L,U,S,A,B); "CODE" 31030; "REAL" "PROCEDURE" VECVEC(L,U,S,A,B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L,U,S,A,B); "CODE" 34011; "REAL" "PROCEDURE" TAMVEC(L,U,S,A,B); "CODE" 34012; "REAL" "PROCEDURE" MATTAM(L,U,S,T,A,B); "CODE" 34015; "INTEGER" "PROCEDURE" QRISNGVALDEC(A,M,N,VAL,V,EM); "CODE" 34273; "PROCEDURE" LOCFUNCT(M,N,PAR,G); "INTEGER" M,N; "ARRAY" PAR,G; "BEGIN" FE:= FE+1; "IF" FE >= MAXFE "THEN" ERR:= 1 "ELSE" "IF" "NOT" FUNCT(M,N,PAR,G) "THEN" ERR:= 2; "IF" ERR^=0 "THEN" "GOTO" EXIT "END" LOCFUNCT; VV:=10; W:=0.5; MU:= 0.01; WW:=("IF" IN[6]<"-7 "THEN" "-8 "ELSE" "-1*IN[6]); EM[0]:=EM[2]:=EM[6]:=IN[0]; EM[4]:=10*N; RELTOLRES:=IN[3]; ABSTOLRES:=IN[4]**2; MAXFE:=IN[5]; ERR:= 0; FE:= IT:= 1; P:=FPAR:= RES:= 0; PW:=-LN(WW*IN[0])/2.30; "IF" "NOT" FUNCT(M,N,PAR,G) "THEN" "BEGIN" ERR:= 3; "GOTO" ESCAPE "END"; FPAR:= VECVEC(1,M,0,G,G); OUT[3]:=SQRT(FPAR); "FOR" IT:= 1, IT+1 "WHILE" FPAR > ABSTOLRES "AND" RES > RELTOLRES*FPAR+ABSTOLRES "DO" "BEGIN" JACOBIAN(M,N,PAR,G,JAC,LOCFUNCT); I:=QRISNGVALDEC(JAC,M,N,VAL,V,EM); "IF" IT=1 "THEN" LAMBDA:= IN[6] * VECVEC(1,N,0,VAL,VAL) "ELSE" "IF" P =0 "THEN" LAMBDA:= LAMBDA*W "ELSE" P:= 0; "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" B[I]:=VAL[I]*TAMVEC(1,M,I,JAC,G); L: "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" BB[I]:=B[I]/(VAL[I]*VAL[I]+LAMBDA); "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" PARPRES[I]:= PAR[I] - MATVEC(1,N,I,V,BB); LOCFUNCT(M,N,PARPRES,G); FPARPRES:= VECVEC(1,M,0,G,G); RES:=FPAR-FPARPRES; "IF" RES < MU * VECVEC(1,N,0,B,BB) "THEN" "BEGIN" P:= P+1; LAMBDA:= VV * LAMBDA; "IF" P=1 "THEN" "BEGIN" LAMBDAMIN:= WW * VECVEC(1,N,0,VAL,VAL); "IF" LAMBDALAMBDA "THEN" LAMBDA := VAL[I] "ELSE" "IF" VAL[I].2 "THEN" "BEGIN" "IF" LIT=0 "THEN" "GOTO" FAIL; LIT:=0; CONV:=1; IT:=1; RECOMP(A,H,T,Z,FAIL,PS); "END"; ASS: MAX1:=MAX; "GOTO" ATER; OUT: "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" Z[I]:=2*Z[I]-Y[I]; "END" ITERATE; "PROCEDURE" RECOMP(A,H,T,Y,FAIL,PS); "REAL" H,T; "ARRAY" A,Y; "LABEL" FAIL; "INTEGER" "ARRAY" PS; "BEGIN" "REAL" SL; "ARRAY" AUX[1:3]; SL:=H/2; "IF" "NOT" AVAILABLE(T,Y,A,N) "THEN" DFDY(T,Y,A); "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" MULROW(1,N,I,I,A,A,-SL); A[I,I]:=1+A[I,I] "END"; AUX[2]:="-14; DEC(A,N,AUX,PS); "IF" AUX[3]1 "THEN" SN:=1; "IF" START "THEN" "BEGIN" SN:=SN**4; LR:=LR*4 "END"; EHR[I]:=B3:=SN*EHR[I]+LR; C3:=C3+B3*B3*W; "END" I; B0:=ERR[1]; ERR[1]:=B1:=SQRT(C0); ERR[2]:=SQRT(C1); ERR[3]:=SQRT(C3)+SQRT(C2)/2; LQ:=EPS/("IF" B0=80 "THEN" LQ:=10; "END"; "PROCEDURE" REJECT; "IF" START "THEN" "BEGIN" HNEW:=LQ**(1/5)*H/2; "GOTO" INIT "END" "ELSE" "BEGIN" "FOR" K:=1,2,3,4,1,2,3 "DO" ELMROW(1,N,K,K+1,R,R,-1); "FOR" K:=1,2,3,4 "DO" ELMROW(1,N,K,K+1,RF,RF,-1); T:=T-H2; HALV:="TRUE"; HNEW:=H; "GOTO" MSTP "END"; "PROCEDURE" STEPSIZE; "IF" LQ<2 "THEN" "BEGIN" HALV:="TRUE"; HNEW:=H "END" "ELSE" "BEGIN" "IF" LQ>80 "THEN" HNEW:=("IF" LQ>5120 "THEN" (LQ/5)**(1/5) "ELSE" 2)*H2; "IF" HNEW>HMAX "THEN" HNEW:=HMAX; "IF" TEND>T "AND" TEND-THMAX "THEN" H:=HMAX "ELSE" H:=H0; "IF" H>(TEND-T0)/4 "THEN" H:=(TEND-T0)/4; "END"; HNEW:=H; ALF:=0; T:=TP:=T0; INIVEC(1,3,ERR,0); INIVEC(1,N,EHR,0); DUPROWVEC(1,N,1,R,Y0); CONTROL(TP,T,H,HNEW,R,ERR,N); INIT: INITIALIZATION; START:="TRUE"; "FOR" ECI:=0,1,2,3 "DO" "BEGIN" ONE LARGE STEP; T:=T+H2; "IF" ECI>0 "THEN" "BEGIN" BACKWARD DIFFERENCES; UPDATE(WEIGHTS,S2,N) "END" "END"; ECI:=4; MSTP: "IF" HNEW^=H2 "THEN" "BEGIN" ECI:=1; CHANGE OF INFORMATION; ONE LARGE STEP; T:=T+H2; ECI:=2; "END"; ONE LARGE STEP; BACKWARD DIFFERENCES; UPDATE(WEIGHTS,S2,N); ERROR ESTIMATES; "IF" ECI<4 "AND" LQ>80 "THEN" LQ:=20; HALV:=TWO:="FALSE"; "IF" PRESCH "THEN" "GOTO" TRYCK; "IF" LQ<1 "THEN" REJECT "ELSE" STEPSIZE; TRYCK: "IF" TP<=T "THEN" CONTROL(TP,T,H,HNEW,R,ERR,N); "IF" START "THEN" START:="FALSE"; "IF" HNEW=H2 "THEN" T:=T+H2; ECI:=ECI+1; "IF" T1 "THEN" T:=T-H2; HALV:=TWO:="FALSE"; HNEW:=H2/2; "IF" START "THEN" "GOTO" INIT "ELSE" "GOTO" TRYCK "END"; END: "END" IMPEX; "COMMENT" ================== 35021 =================; "PROCEDURE" ERRORFUNCTION(X, ERF, ERFC); "VALUE" X; "REAL" X, ERF, ERFC; "IF" X > 26 "THEN" "BEGIN" ERF:= 1; ERFC:= 0 "END" "ELSE" "IF" X < -5.5 "THEN" "BEGIN" ERF:= -1; ERFC:= 2 "END" "ELSE" "BEGIN" "REAL" ABSX, C, P, Q; "REAL" "PROCEDURE" NONEXPERFC(X); "CODE" 35022; ABSX:= ABS(X); "IF" ABSX <= 0.5 "THEN" "BEGIN" C:= X * X; P:= ((-0.35609 84370 18154"-1 * C + 0.69963 83488 61914"+1) * C + 0.21979 26161 82942"+2) * C + 0.24266 79552 30532"+3; Q:= ((C + 0.15082 79763 04078"+2) * C + 0.91164 90540 45149"+2) * C + 0.21505 88758 69861"+3; ERF:= X * P / Q; ERFC:= 1 - ERF "END" "ELSE" "BEGIN" ERFC:= EXP(-X * X) * NONEXPERFC(ABSX); ERF:= 1 - ERFC; "IF" X < 0 "THEN" "BEGIN" ERF:= -ERF; ERFC:= 2 - ERFC "END" "END" "END" ERRORFUNCTION; "COMMENT" ================== 35022 =================; "REAL" "PROCEDURE" NONEXPERFC(X); "VALUE" X; "REAL" X; "BEGIN" "REAL" ABSX, ERF, ERFC, C, P, Q; "PROCEDURE" ERRORFUNCTION(X, ERF, ERFC); "CODE" 35021; ABSX:= ABS(X); "IF" ABSX <= 0.5 "THEN" "BEGIN" ERRORFUNCTION(X, ERF, ERFC); NONEXPERFC:= EXP(X * X) * ERFC "END" "ELSE" "IF" ABSX < 4 "THEN" "BEGIN" C:= ABSX; P:= ((((((-0.13686 48573 82717"-6 * C + 0.56419 55174 78974"+0) * C + 0.72117 58250 88309"+1) * C + 0.43162 22722 20567"+2) * C + 0.15298 92850 46940"+3) * C + 0.33932 08167 34344"+3) * C + 0.45191 89537 11873"+3) * C + 0.30045 92610 20162"+3; Q:= ((((((C + 0.12782 72731 96294"+2) * C + 0.77000 15293 52295"+2) * C + 0.27758 54447 43988"+3) * C + 0.63898 02644 65631"+3) * C + 0.93135 40948 50610"+3) * C + 0.79095 09253 27898"+3) * C + 0.30045 92609 56983"+3; NONEXPERFC:= "IF" X > 0 "THEN" P / Q "ELSE" EXP(X * X) * 2 - P / Q "END" "ELSE" "BEGIN" C:= 1 / X / X; P:= (((0.22319 24597 34185"-1 * C + 0.27866 13086 09648"-0) * C + 0.22695 65935 39687"-0) * C + 0.49473 09106 23251"-1) * C + 0.29961 07077 03542"-2; Q:= (((C + 0.19873 32018 17135"+1) * C + 0.10516 75107 06793"+1) * C + 0.19130 89261 07830"+0) * C + 0.10620 92305 28468"-1; C:= (C * (-P) / Q + 0.56418 95835 47756) / ABSX; NONEXPERFC:= "IF" X > 0 "THEN" C "ELSE" EXP(X * X) * 2 - C "END" "END" NONEXPERFC; "COMMENT" ================== 35027 =================; "PROCEDURE" FRESNEL(X, C, S); "VALUE" X; "REAL" X, C, S; "BEGIN" "REAL" ABSX, X3, X4, A, P, Q, F, G, C1, S1; "PROCEDURE" FG(X, F, G); "CODE" 35028; ABSX:= ABS(X); "IF" ABSX <= 1.2 "THEN" "BEGIN" A:= X * X; X3:= A * X; X4:= A * A; P:= (((5.47711 38568 2687"-6 * X4 - 5.28079 65137 2623"-4) * X4 + 1.76193 95254 3491"-2) * X4 - 1.99460 89882 6184"-1) * X4 + 1; Q:= (((1.18938 90142 2876"-7 * X4 + 1.55237 88527 6994"-5) * X4 + 1.09957 21502 5642"-3) * X4 + 4.72792 11201 0453"-2) * X4 + 1; C:= X * P / Q; P:= (((6.71748 46662 5141"-7 * X4 - 8.45557 28435 2777"-5) * X4 + 3.87782 12346 3683"-3) * X4 - 7.07489 91514 4523"-2) * X4 + 5.23598 77559 8299"-1; Q:= (((5.95281 22767 8410"-8 * X4 + 9.62690 87593 9034"-6) * X4 + 8.17091 94215 2134"-4) * X4 + 4.11223 15114 2384"-2) * X4 + 1; S:= X3 * P / Q "END" "ELSE" "IF" ABSX <= 1.6 "THEN" "BEGIN" A:= X * X; X3:= A * X; X4:= A * A; P:=((((-5.68293 31012 1871"-8 * X4 + 1.02365 43505 6106"-5) * X4 - 6.71376 03469 4922"-4) * X4 + 1.91870 27943 1747"-2) * X4 - 2.07073 36033 5324"-1) * X4 + 1.00000 00000 0111"+0; Q:=((((4.41701 37406 5010"-10 * X4 + 8.77945 37789 2369"-8) * X4 + 1.01344 63086 6749"-5) * X4 + 7.88905 24505 2360"-4) * X4 + 3.96667 49695 2323"-2) * X4 + 1; C:= X * P / Q; P:=((((-5.76765 81559 3089"-9 * X4 + 1.28531 04374 2725"-6) * X4 - 1.09540 02391 1435"-4) * X4 + 4.30730 52650 4367"-3) * X4 - 7.37766 91401 0191"-2) * X4 + 5.23598 77559 8344"-1; Q:=((((2.05539 12445 8580"-10 * X4 + 5.03090 58124 6612"-8) * X4 + 6.87086 26571 8620"-6) * X4 + 6.18224 62019 5473"-4) * X4 + 3.53398 34276 7472"-2) * X4 + 1; S:= X3 * P / Q "END" "ELSE" "IF" ABSX < "15 "THEN" "BEGIN" FG(X, F, G); A:= X * X; A:= (A - ENTIER(A / 4) * 4) * 1.57079 63267 9490; C1:= COS(A); S1:= SIN(A); A:= "IF" X < 0 "THEN" -0.5 "ELSE" 0.5; C:= F * S1 - G * C1 + A; S:= -F * C1 - G * S1 + A "END" "ELSE" C:= S:= SIGN(X) * 0.5 "END" FRESNEL; "COMMENT" ================== 35028 =================; "PROCEDURE" FG(X, F, G); "VALUE" X; "REAL" X, F, G; "BEGIN" "REAL" ABSX, C, S, C1, S1, A, XINV, X3INV, C4, P, Q; "PROCEDURE" FRESNEL(X, C, S); "CODE" 35027; ABSX:= ABS(X); "IF" ABSX <= 1.6 "THEN" "BEGIN" FRESNEL(X, C, S); A:= X * X * 1.57079 63267 9490; C1:= COS(A); S1:= SIN(A); A:= "IF" X < 0 "THEN" -0.5 "ELSE" 0.5; P:= A - C; Q:= A - S; F:= Q * C1 - P * S1; G:= P * C1 + Q * S1 "END" "ELSE" "IF" ABSX <= 1.9 "THEN" "BEGIN" XINV:= 1 / X; A:= XINV * XINV; X3INV:= A * XINV; C4:= A * A; P:= (((1.35304 23554 0388"+1 * C4 + 6.98534 26160 1021"+1) * C4 + 4.80340 65557 7925"+1) * C4 + 8.03588 12280 3942"+0) * C4 + 3.18309 26850 4906"-1; Q:= (((6.55630 64008 3916"+1 * C4 + 2.49561 99380 5172"+2) * C4 + 1.57611 00558 0123"+2) * C4 + 2.55491 61843 5795"+1) * C4 + 1; F:= XINV * P / Q; P:=((((2.05421 43249 8501"+1 * C4 + 1.96232 03797 1663"+2) * C4 + 1.99182 81867 8903"+2) * C4 + 5.31122 81348 0989"+1) * C4 + 4.44533 82755 0512"+0) * C4 + 1.01320 61881 0275"-1; Q:=((((1.01379 48339 6003"+3 * C4 + 3.48112 14785 6545"+3) * C4 + 2.54473 13318 1822"+3) * C4 + 5.83590 57571 6429"+2) * C4 + 4.53925 01967 3689"+1) * C4 + 1; G:= X3INV * P / Q "END" "ELSE" "IF" ABSX <= 2.4 "THEN" "BEGIN" XINV:= 1 / X; A:= XINV * XINV; X3INV:= A * XINV; C4:= A * A; P:=((((7.17703 24936 5140"+2 * C4 + 3.09145 16157 4430"+3) * C4 + 1.93007 64078 6716"+3) * C4 + 3.39837 13492 6984"+2) * C4 + 1.95883 94102 1969"+1) * C4 + 3.18309 88182 2017"-1; Q:=((((3.36121 69918 0551"+3 * C4 + 1.09334 24898 8809"+4) * C4 + 6.33747 15585 1144"+3) * C4 + 1.08535 06750 0650"+3) * C4 + 6.18427 13817 2887"+1) * C4 + 1; F:= XINV * P / Q; P:=((((3.13330 16306 8756"+2 * C4 + 1.59268 00608 5354"+3) * C4 + 9.08311 74952 9594"+2) * C4 + 1.40959 61791 1316"+2) * C4 + 7.11205 00178 9783"+0) * C4 + 1.01321 16176 1805"-1; Q:=((((1.15149 83237 6261"+4 * C4 + 2.41315 56721 3370"+4) * C4 + 1.06729 67803 0581"+4) * C4 + 1.49051 92279 7329"+3) * C4 + 7.17128 59693 9302"+1) * C4 + 1; G:= X3INV * P / Q "END" "ELSE" "BEGIN" XINV:= 1 / X; A:= XINV * XINV; X3INV:= A * XINV; C4:= A * A; P:=((((2.61294 75322 5142"+4 * C4 + 6.13547 11361 4700"+4) * C4 + 1.34922 02817 1857"+4) * C4 + 8.16343 40178 4375"+2) * C4 + 1.64797 71284 1246"+1) * C4 + 9.67546 03296 7090"-2; Q:=((((1.37012 36481 7226"+6 * C4 + 1.00105 47890 0791"+6) * C4 + 1.65946 46262 1853"+5) * C4 + 9.01827 59623 1524"+3) * C4 + 1.73871 69067 3649"+2) * C4 + 1; F:= (C4 * (-P) / Q + 0.31830 98861 83791) * XINV; P:=(((((1.72590 22465 4837"+6 * C4 + 6.66907 06166 8636"+6) * C4 + 1.77758 95083 8030"+6) * C4 + 1.35678 86781 3756"+5) * C4 + 3.87754 14174 6378"+3) * C4 + 4.31710 15782 3358"+1) * C4 + 1.53989 73381 9769"-1; Q:=(((((1.40622 44112 3580"+8 * C4 + 9.38695 86253 1635"+7) * C4 + 1.62095 60050 0232"+7) * C4 + 1.02878 69305 6688"+6) * C4 + 2.69183 18039 6243"+4) * C4 + 2.86733 19497 5899"+2) * C4 + 1; G:= (C4 * (-P) / Q + 0.10132 11836 42338) * X3INV "END" "END" FG; "COMMENT" ================== 34453 =================; "BOOLEAN" "PROCEDURE" ZEROINDER(X, Y, FX, DFX, TOLX); "REAL" X, Y, FX, DFX, TOLX; "BEGIN" "INTEGER" EXT; "REAL" B, FB, DFB, A, FA, DFA, C, FC, DFC, D, W, MB, TOL, M, P, Q, DW; "REAL" "PROCEDURE" DWARF; "CODE" 30003; DW:= DWARF; B:= X; FB:= FX; DFB:= DFX; A:= X:= Y; FA:= FX; DFA:= DFX; INTERPOLATE: C:= A; FC:= FA; DFC:= DFA; EXT:= 0; EXTRAPOLATE: "IF" ABS(FC) < ABS(FB) "THEN" "BEGIN" A:= B; FA:= FB; DFA:= DFB; B:= X:= C; FB:= FC; DFB:= DFC; C:= A; FC:= FA; DFC:= DFA "END" INTERCHANGE; TOL:= TOLX; M:= (C + B) * 0.5; MB:= M - B; "IF" ABS(MB) > TOL "THEN" "BEGIN" "IF" EXT > 2 "THEN" W:= MB "ELSE" "BEGIN" TOL:= TOL * SIGN(MB); D:= "IF" EXT = 2 "THEN" DFA "ELSE" (FB - FA) / (B - A); P:= FB * D * (B - A); Q:= FA * DFB - FB * D; "IF" P < 0 "THEN" "BEGIN" P:= -P; Q:= -Q "END"; W:= "IF" P < DW "OR" P <= Q * TOL "THEN" TOL "ELSE" "IF" P < MB * Q "THEN" P / Q "ELSE" MB; "END"; A:= B; FA:= FB; DFA:= DFB; X:= B:= B + W; FB:= FX; DFB:= DFX; "IF" ("IF" FC >= 0 "THEN" FB >= 0 "ELSE" FB <= 0) "THEN" "GOTO" INTERPOLATE "ELSE" "BEGIN" EXT:= "IF" W = MB "THEN" 0 "ELSE" EXT + 1; "GOTO" EXTRAPOLATE "END" "END"; Y:= C; ZEROINDER:= "IF" FC >= 0 "THEN" FB <= 0 "ELSE" FB >= 0 "END" ZEROINDER; "COMMENT" ================== 34432 =================; "PROCEDURE" PRAXIS(N, X, FUNCT, IN, OUT); "VALUE" N; "INTEGER" N; "ARRAY" X, IN, OUT; "REAL" "PROCEDURE" FUNCT; "BEGIN" "COMMENT"THIS PROCEDURE MINIMIZES FUNCT(N,X),WITH THE PRINCIPAL AXIS METHOD (SEE BRENT,R.P, 1973, ALGORITHMS FOR MINIMIZATION WITHOUT DERIVATIVES,CH.7); "PROCEDURE" INIVEC(L, U, A, X); "CODE" 31010; "PROCEDURE" INIMAT(L, U, K, V, A, X); "CODE" 31011; "PROCEDURE" DUPVEC(L, U, K, A, X); "CODE" 31030; "PROCEDURE" DUPMAT(L, U, K, V, A, B); "CODE" 31035; "PROCEDURE" DUPCOLVEC(L, U, K, A, B); "CODE" 31034; "PROCEDURE" MULROW(L, U, I, J, A, B, X); "CODE" 31021; "PROCEDURE" MULCOL(L, U, I, J, A, B, X); "CODE" 31022; "REAL" "PROCEDURE" VECVEC(L, U, S, A, B); "CODE" 34010; "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "REAL" "PROCEDURE" MATTAM(L, U, I, J, A, B); "CODE" 34015; "PROCEDURE" ICHROWCOL(L, U, I, J, A); "CODE" 34033; "PROCEDURE" ELMVECCOL(L, U, I, A, B, X); "CODE" 34021; "INTEGER" "PROCEDURE" QRISNGVALDEC(A,M,N,VAL,V,EM); "CODE" 34273; "PROCEDURE" SETRANDOM(X); "CODE" 11014; "REAL" "PROCEDURE" RANDOM; "CODE" 11015; "REAL" "PROCEDURE" DWARF; "CODE" 30003; "PROCEDURE" SORT; "BEGIN" "INTEGER" I, J, K; "REAL" S; "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO" "BEGIN" K:= I; S:= D[I]; "FOR" J:= I+1 "STEP" 1 "UNTIL" N "DO" "IF" D[J]>S "THEN" "BEGIN" K:= J; S:= D[J] "END"; "IF" K>I "THEN" "BEGIN" D[K]:= D[I]; D[I]:= S; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" S:=V[J,I]; V[J,I]:= V[J,K]; V[J,K]:= S "END" "END" "END" "END" SORT; "PROCEDURE" MIN(J, NITS, D2, X1, F1, FK); "VALUE" J, NITS, FK; "INTEGER" J, NITS; "REAL" D2, X1, F1; "BOOLEAN" FK; "BEGIN" "REAL" "PROCEDURE" FLIN(L); "VALUE" L; "REAL" L; "BEGIN" "INTEGER" I; "ARRAY" T[1:N]; "IF" J > 0 "THEN" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" T[I]:= X[I] + L * V[I,J] "END" "ELSE" "BEGIN" "COMMENT" SEARCH ALONG PARABOLIC SPACE CURVE; QA:= L * (L - QD1) / (QD0 * (QD0 + QD1)); QB:= (L + QD0) * (QD1 - L) /(QD0 * QD1); QC:= L * (L + QD0) / (QD1 * (QD0 + QD1)); "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" T[I]:= QA * Q0[I] +QB * X[I] + QC * Q1[I] "END"; NF:= NF + 1; FLIN:= FUNCT(N, T) "END" FLIN; "INTEGER" K; "BOOLEAN" DZ; "REAL" X2, XM, F0, F2, FM, D1, T2, S, SF1, SX1; SF1:= F1; SX1:= X1; K:= 0; XM:= 0; F0:= FM:= FX; DZ:= D2 < RELTOL; S:= SQRT(VECVEC(1,N,0,X,X)); T2:= M4 * SQRT(ABS(FX) / ("IF" DZ "THEN" DMIN "ELSE" D2) + S * LDT) + M2 * LDT; S:= S * M4 + ABSTOL; "IF" DZ "AND" T2 > S "THEN" T2:= S; "IF"T20.01*H "THEN"T2:= 0.01*H; "IF"FK"AND"F1<=FM "THEN" "BEGIN"XM:=X1; FM:= F1 "END"; "IF" ^ FK"OR"ABS(X1)0 "THEN"T2"ELSE"-T2; F1:= FLIN(X1) "END"; "IF"F1<= FM"THEN" "BEGIN"XM:= X1; FM:= F1 "END"; L0: "IF" DZ "THEN" "BEGIN" "COMMENT"EVALUATE FLIN AT ANOTHER POINT AND ESTIMATE THE SECOND DERIVATIVE; X2:= "IF" F0 < F1 "THEN" -X1 "ELSE" X1 * 2; F2:= FLIN(X2); "IF"F2 <= FM "THEN" "BEGIN" XM:= X2; FM:= F2 "END"; D2:=(X2*(F1-F0)-X1*(F2-F0))/(X1*X2*(X1-X2)) "END"; "COMMENT"ESTIMATE FIRST DERIVATIVE AT 0; D1:=(F1-F0)/X1-X1*D2; DZ:="TRUE"; X2:= "IF"D2<=SMALL"THEN" ("IF"D1<0"THEN"H"ELSE"-H) "ELSE"-0.5*D1/D2; "IF"ABS(X2)>H"THEN"X2:="IF"X2>0"THEN"H"ELSE"-H; L1: F2:=FLIN(X2); "IF"KF0"THEN" "BEGIN"K:=K+1; "IF"F00"THEN" "GOTO"L0; X2:= 0.5*X2; "GOTO"L1 "END"; NL:= NL+1; "IF"F2>FM"THEN"X2:=XM"ELSE"FM:=F2; D2:="IF"ABS(X2*(X2-X1))>SMALL"THEN" (X2*(F1-F0)-X1*(FM-F0))/(X1*X2*(X1-X2)) "ELSE" "IF"K>0"THEN"0"ELSE"D2; "IF"D2<=SMALL"THEN"D2:=SMALL; X1:=X2; FX:=FM; "IF"SF10"THEN"ELMVECCOL(1,N,J,X,V,X1) "END" MIN; "PROCEDURE"QUAD; "BEGIN" "INTEGER" I; "REAL" L, S; S:= FX; FX:= QF1; QF1:= S; QD1:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN"S:=X[I]; X[I]:= L:= Q1[I]; Q1[I]:= S; QD1:= QD1 + (S - L) ** 2 "END"; L:=QD1:=SQRT(QD1); S:= 0; "IF"(QD0*QD1>DWARF)"AND"NL>=3*N*N"THEN" "BEGIN"MIN(0,2,S,L,QF1,"TRUE"); QA:= L*(L-QD1)/(QD0*(QD0+QD1)); QB:=(L+QD0)*(QD1-L)/(QD0*QD1); QC:= L*(L+QD0)/(QD1*(QD0+QD1)) "END" "ELSE" "BEGIN" FX:= QF1; QA:= QB:= 0; QC:= 1 "END"; QD0:= QD1;"FOR"I:= 1"STEP"1"UNTIL"N"DO" "BEGIN"S:=Q0[I]; Q0[I]:=X[I]; X[I]:= QA*S + QB*X[I]+QC*Q1[I] "END" "END" QUAD; "BOOLEAN" ILLC; "INTEGER" I, J, K, K2, NL, MAXF, NF, KL, KT, KTM; "REAL" S, SL, DN, DMIN, FX, F1, LDS, LDT, SF, DF, QF1, QD0, QD1, QA, QB, QC, M2, M4, SMALL, VSMALL, LARGE, VLARGE, SCBD, LDFAC,T2, MACHEPS, RELTOL, ABSTOL, H; "ARRAY" V[1:N,1:N], D, Y, Z, Q0, Q1[1:N]; MACHEPS:= IN[0]; RELTOL:= IN[1]; ABSTOL:= IN[2]; MAXF:= IN[5]; H:= IN[6]; SCBD:= IN[7]; KTM:= IN[8]; ILLC:= IN[9] < 0; SMALL:= MACHEPS ** 2; VSMALL:= SMALL ** 2; LARGE:= 1/SMALL; VLARGE:= 1/VSMALL; M2:= RELTOL; M4:= SQRT(M2); SETRANDOM(0.5); LDFAC:= "IF" ILLC "THEN" 0.1 "ELSE" 0.01; KT:=NL:=0; NF:=1; OUT[3]:= QF1:=FX:=FUNCT(N,X); ABSTOL:=T2:= SMALL+ABS(ABSTOL); DMIN:= SMALL; "IF" H= D[1] "THEN" INIVEC(2,N,D,0); "FOR" K:= 2"STEP"1"UNTIL"N"DO" "BEGIN" DUPVEC(1,N,0,Y,X); SF:=FX; ILLC:= ILLC "OR" KT>0; L1: KL:=K; DF:= 0; "IF" ILLC "THEN" "BEGIN" "COMMENT"RANDOM STOP TO GET OFF RESULTION VALLEY; "FOR"I:= 1 "STEP"1"UNTIL"N"DO" "BEGIN"S:=Z[I]:=(0.1*LDT+T2*10**KT) *(RANDOM-0.5); ELMVECCOL(1,N,I,X,V,S) "END"; FX:= FUNCT(N,X); NF:= NF+1 "END"; "FOR"K2:= K "STEP" 1 "UNTIL" N "DO" "BEGIN" SL:=FX; S:= 0; MIN (K2, 2, D[K2], S, FX, "FALSE"); S:="IF" ILLC "THEN" D[K2] * (S + Z[K2]) ** 2 "ELSE"SL-FX;"IF"DF SMALL "THEN" "BEGIN" "FOR" I:= KL - 1 "STEP" -1 "UNTIL" K "DO" "BEGIN" "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" V[J, I + 1]:= V[J,I]; D[I + 1]:= D[I] "END"; D[K]:= 0; DUPCOLVEC(1, N, K, V, Y); MULCOL(1, N, K, K, V, V, 1 / LDS); MIN(K, 4, D[K], LDS, F1, "TRUE"); "IF" LDS <= 0 "THEN" "BEGIN" LDS:= LDS; MULCOL(1, N, K, K, V, V, -1) "END" "END"; LDT:= LDFAC * LDT; "IF" LDT < LDS "THEN" LDT:= LDS; T2:= M2 * SQRT(VECVEC(1, N, 0, X, X)) + ABSTOL; KT:= "IF" LDT > 0.5 * T2 "THEN" 0 "ELSE" KT + 1; "IF" KT > KTM "THEN" "BEGIN" OUT[1]:= 0; "GOTO" L2 "END" "END"; QUAD; DN:= 0;"FOR"I:= 1"STEP"1"UNTIL"N"DO" "BEGIN"D[I]:= 1/SQRT(D[I]); "IF"DN1"THEN" "BEGIN"S:=VLARGE; "FOR"I:=1 "STEP"1"UNTIL"N"DO" "BEGIN" SL:= Z[I]:= SQRT(MATTAM(1, N, I, I, V, V)); "IF"SLSL "THEN" S:= SL "END"; "FOR"I:=1"STEP"1"UNTIL"N"DO" "BEGIN"SL:=S/Z[I];Z[I]:= 1/SL; "IF"Z[I]>SCBD"THEN" "BEGIN"SL:=1/SCBD; Z[I]:= SCBD"END"; MULROW(1, N, I, I, V, V, SL) "END" "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" ICHROWCOL(I + 1, N, I, I, V); "BEGIN" "ARRAY" A[1:N,1:N], EM[0:7]; EM[0]:= EM[2]:= MACHEPS; EM[4]:= 10 * N; EM[6]:= VSMALL; DUPMAT(1, N, 1, N, A, V); "IF" QRISNGVALDEC(A, N, N, D, V, EM) ^= 0 "THEN" "BEGIN" OUT[1]:= 2; "GOTO" L2 "END"; "END"; "IF"SCBD>1"THEN" "BEGIN" "FOR"I:=1"STEP"1"UNTIL"N"DO" MULROW(1,N,I,I,V,V,Z[I]); "FOR"I:= 1"STEP"1"UNTIL"N"DO" "BEGIN"S:= SQRT(TAMMAT(1,N,I,I,V,V)); D[I]:= S*D[I]; S:= 1/S; MULCOL(1,N,I,I,V,V,S) "END" "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" S:= DN * D[I]; D[I]:= "IF" S > LARGE "THEN" VSMALL "ELSE" "IF" S < SMALL "THEN" VLARGE "ELSE" S ** (-2) "END"; SORT; DMIN:= D[N]; "IF" DMIN < SMALL "THEN" DMIN:= SMALL; ILLC:= (M2 * D[1]) > DMIN; "IF" NF < MAXF "THEN" "GOTO" L0 "ELSE" OUT[1]:= 1; L2: OUT[2]:= FX; OUT[4]:= NF; OUT[5]:= NL; OUT[6]:= LDT "END"PRAXIS; "COMMENT" ================== 31061 =================; "REAL" "PROCEDURE" INFNRMVEC(L, U, K, A); "VALUE" L, U; "INTEGER" L, U, K; "ARRAY" A; "BEGIN" "REAL" R, MAX; MAX:= 0; K:= L; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" R:= ABS(A[L]); "IF" R > MAX "THEN" "BEGIN" MAX:= R; K:= L "END" "END"; INFNRMVEC:= MAX "END" INFNRMVEC; "COMMENT" ================== 31062 =================; "REAL" "PROCEDURE" INFNRMROW(L, U, I, K, A); "VALUE" L, U, I; "INTEGER" L, U, I, K; "ARRAY" A; "BEGIN" "REAL" R, MAX; MAX:= 0; K:= L; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" R:= ABS(A[I,L]); "IF" R > MAX "THEN" "BEGIN" MAX:= R; K:= L "END" "END"; INFNRMROW:= MAX "END" INFNRMROW; "COMMENT" ================== 31063 =================; "REAL" "PROCEDURE" INFNRMCOL(L, U, J, K, A); "VALUE" L, U, J; "INTEGER" L, U, J, K; "ARRAY" A; "BEGIN" "REAL" R, MAX; MAX:= 0; K:= L; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" R:= ABS(A[L,J]); "IF" R > MAX "THEN" "BEGIN" MAX:= R; K:= L "END" "END"; INFNRMCOL:= MAX "END" INFNRMCOL; "COMMENT" ================== 31064 =================; "REAL" "PROCEDURE" INFNRMMAT(LR, UR, LC, UC, KR, A); "VALUE" LR, UR, LC, UC; "INTEGER" LR, UR, LC, UC, KR; "ARRAY" A; "BEGIN" "REAL" R, MAX; "REAL" "PROCEDURE" ONENRMROW(L, U, I, A); "CODE" 31066; MAX:= 0; KR:= LR; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" "BEGIN" R:= ONENRMROW(LC, UC, LR, A); "IF" R > MAX "THEN" "BEGIN" MAX:= R; KR:= LR "END" "END"; INFNRMMAT:= MAX "END" INFNRMMAT; "COMMENT" ================== 31065 =================; "REAL" "PROCEDURE" ONENRMVEC(L, U, A); "VALUE" L, U; "INTEGER" L, U; "ARRAY" A; "BEGIN" "REAL" SUM; SUM:= 0; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" SUM:= SUM + ABS(A[L]); ONENRMVEC:= SUM "END" ONENRMVEC; "COMMENT" ================== 31066 =================; "REAL" "PROCEDURE" ONENRMROW(L, U, I, A); "VALUE" L, U, I; "INTEGER" L, U, I; "ARRAY" A; "BEGIN" "REAL" SUM; SUM:= 0; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" SUM:= SUM + ABS(A[I,L]); ONENRMROW:= SUM "END" ONENRMROW; "COMMENT" ================== 31067 =================; "REAL" "PROCEDURE" ONENRMCOL(L, U, J, A); "VALUE" L, U, J; "INTEGER" L, U, J; "ARRAY" A; "BEGIN" "REAL" SUM; SUM:= 0; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" SUM:= SUM + ABS(A[L,J]); ONENRMCOL:= SUM "END" ONENRMCOL; "COMMENT" ================== 31068 =================; "REAL" "PROCEDURE" ONENRMMAT(LR, UR, LC, UC, KC, A); "VALUE" LR, UR, LC, UC; "INTEGER" LR, UR, LC, UC, KC; "ARRAY" A; "BEGIN" "REAL" MAX, R; "REAL" "PROCEDURE" ONENRMCOL(L, U, J, A); "CODE" 31067; MAX:= 0; KC:= LC; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" "BEGIN" R:= ONENRMCOL(LR, UR, LC, A); "IF" R > MAX "THEN" "BEGIN" MAX:= R; KC:= LC "END" "END"; ONENRMMAT:= MAX "END" ONENRMMAT; "COMMENT" ================== 31069 =================; "REAL" "PROCEDURE" ABSMAXMAT(LR, UR, LC, UC, I, J, A); "VALUE" LR, UR, LC, UC; "INTEGER" LR, UR, LC, UC, I, J; "ARRAY" A; "BEGIN" "INTEGER" II; "REAL" MAX, R; "REAL" "PROCEDURE" INFNRMCOL(L, U, I, K, A); "CODE" 31063; MAX:= 0; I:= LR; J:= LC; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" "BEGIN" R:= INFNRMCOL(LR, UR, LC, II, A); "IF" R > MAX "THEN" "BEGIN" MAX:= R; I:= II; J:= LC "END" "END"; ABSMAXMAT:= MAX "END" ABSMAXMAT; "COMMENT" ================== 35140 =================; "PROCEDURE" AIRY(Z,AI,AID,BI,BID,EXPON,FIRST); "VALUE" Z,FIRST; "BOOLEAN" FIRST; "REAL" Z,AI,AID,BI,BID,EXPON; "BEGIN" "REAL" S,T,U,V,SC,TC,UC,VC,X,K1,K2,K3,K4, C,ZT,SI,CO,EXPZT,SQRTZ,WWL,PL,PL1,PL2,PL3; "OWN" "REAL" C1,C2,SQRT3,SQRT1OPI,PIO4; "OWN" "REAL" "ARRAY" XX,WW[1:10]; "INTEGER" N,L; "IF" FIRST "THEN" "BEGIN" SQRT3:= 1.73205080756887729; SQRT1OPI:= 0.56418958354775629; PIO4:= 0.78539816339744831; C1:= 0.35502 80538 87817; C2:= 0.25881 94037 92807; XX[ 1]:= 1.40830 81072 180964 "+1; XX[ 2]:= 1.02148 85479 197331 "+1; XX[ 3]:= 7.44160 18450 450930 ; XX[ 4]:= 5.30709 43061 781927 ; XX[ 5]:= 3.63401 35029 132462 ; XX[ 6]:= 2.33106 52303 052450 ; XX[ 7]:= 1.34479 70824 609268 ; XX[ 8]:= 6.41888 58369 567296 "-1; XX[ 9]:= 2.01003 45998 121046 "-1; XX[10]:= 8.05943 59172 052833 "-3; WW[ 1]:= 3.15425 15762 964787"-14; WW[ 2]:= 6.63942 10819 584921"-11; WW[ 3]:= 1.75838 89061 345669"- 8; WW[ 4]:= 1.37123 92370 435815"- 6; WW[ 5]:= 4.43509 66639 284350"- 5; WW[ 6]:= 7.15550 10917 718255"- 4; WW[ 7]:= 6.48895 66103 335381"- 3; WW[ 8]:= 3.64404 15875 773282"- 2; WW[ 9]:= 1.43997 92418 590999"- 1; WW[10]:= 8.12311 41336 261486"- 1; "END"; EXPON:= 0; "IF" Z >= -5.0 "AND" Z <= 8 "THEN" "BEGIN" U:= V:= T:= UC:= VC:= TC:= 1; S:= SC:= 0.5; N:= 0; X:= Z*Z*Z; "FOR" N:= N+3 "WHILE" ABS(U)+ABS(V)+ABS(S)+ABS(T) > "-18 "DO" "BEGIN" U:=U*X/(N*(N-1)); V:= V*X/(N*(N+1)); S:=S*X/(N*(N+2)); T:= T*X/(N*(N-2)); UC:= UC+U; VC:= VC+V; SC:= SC+S; TC:= TC+T "END"; BI:= SQRT3 * (C1*UC + C2*Z*VC); BID:=SQRT3 * (C1*Z*Z*SC +C2*TC); "IF" Z<2.5 "THEN" "BEGIN" AI:= C1*UC - C2*Z*VC; AID:= C1*SC*Z*Z - C2*TC; "GOTO" END "END" "END"; K1:= K2:= K3:= K4:= 0; SQRTZ:= SQRT(ABS(Z)); ZT:= 0.66666 66666 66667 * ABS(Z)*SQRTZ; C:= SQRT1OPI/SQRT(SQRTZ); "IF" Z<0 "THEN" "BEGIN" Z:= -Z; CO:= COS(ZT-PIO4); SI:= SIN(ZT-PIO4); "FOR" L:= 1 "STEP" 1 "UNTIL" 10 "DO" "BEGIN" WWL:= WW[L]; PL:= XX[L]/ZT; PL2:=PL*PL; PL1:= 1+PL2; PL3:= PL1*PL1; K1:= K1 + WWL/PL1; K2:= K2 + WWL*PL/PL1; K3:= K3 + WWL*PL*(1+PL*(2/ZT+PL))/PL3; K4:= K4 + WWL*(-1-PL*(1+PL*(ZT-PL))/ZT)/PL3; "END"; AI:= C*(CO*K1+SI*K2); AID:= 0.25*AI/Z - C*SQRTZ*(CO*K3+SI*K4); BI:= C*(CO*K2-SI*K1); BID:= 0.25*BI/Z - C*SQRTZ*(CO*K4-SI*K3); "END" "ELSE" "BEGIN" "IF" Z < 9 "THEN" EXPZT:= EXP(ZT) "ELSE" "BEGIN" EXPZT:= 1; EXPON:= ZT "END"; "FOR" L:= 1 "STEP" 1 "UNTIL" 10 "DO" "BEGIN" WWL:= WW[L]; PL:= XX[L]/ZT; PL1:= 1+PL; PL2:= 1-PL; K1:= K1 + WWL/PL1; K2:= K2 + WWL*PL/(ZT*PL1*PL1); K3:= K3 + WWL/PL2; K4:= K4 + WWL*PL/(ZT*PL2*PL2); "END"; AI:= 0.5*C*K1/EXPZT; AID:= AI*(-.25/Z-SQRTZ) + 0.5*C*SQRTZ*K2/EXPZT; "IF" Z >= 8 "THEN" "BEGIN" BI:= C*K3*EXPZT; BID:= BI*(SQRTZ-0.25/Z) - C*K4*SQRTZ*EXPZT; "END"; "END"; END: "END" AIRY; "COMMENT" ================== 35145 =================; "REAL" "PROCEDURE" AIRYZEROS(N,D,ZAI,VAI); "VALUE" N,D; "INTEGER" N,D; "ARRAY" ZAI,VAI; "BEGIN" "BOOLEAN" A, FOUND; "INTEGER" I; "REAL" C,E,R,ZAJ,ZAK,VAJ,DAJ,KAJ,ZZ; "PROCEDURE" AIRY(A,B,C,D,E,F,G); "CODE" 35140; A := D = 0 "OR" D = 2; R := "IF" D = 0 "OR" D = 3 "THEN" -1.1780 97245 09617 "ELSE" -3.5342 91735 28852; "COMMENT" R := "IF" D = 0 "OR" D = 3 "THEN" -3 * PI / 8 "ELSE" -9 * PI / 8; AIRY(0,ZAJ,VAJ,DAJ,KAJ,ZZ,"TRUE"); "FOR" I := 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" R := R + 4.7123 88980 38469; "COMMENT" R := R + 3 * PI / 2; ZZ := R * R; ZAJ := "IF" I = 1 "AND" D = 1 "THEN" -1.01879 297 "ELSE" "IF" I = 1 "AND" D = 2 "THEN" -1.17371 322 "ELSE" R ** 0.66666 66666 66667 * ( "IF" A "THEN" - ( 1 + ( 5/48 - ( 5/36 - ( 77125/82944 - ( 1080 56875 / 69 67296 - (16 23755 96875 / 3344 30208) /ZZ)/ZZ)/ZZ)/ZZ)/ZZ) "ELSE" - ( 1 - ( 7/48 - ( 35/288 - ( 1 81223 / 2 07360 - ( 186 83371 / 12 44160 - ( 9 11458 84361 / 1911 02976 ) /ZZ)/ZZ)/ZZ)/ZZ)/ZZ)); "IF" D <= 1 "THEN" AIRY(ZAJ,VAJ,DAJ,C,E,ZZ,"FALSE") "ELSE" AIRY(ZAJ,C,E,VAJ,DAJ,ZZ,"FALSE"); FOUND := ABS( "IF" A "THEN" VAJ "ELSE" DAJ ) < "-12; "FOR" C := C "WHILE" "NOT" FOUND "DO" "BEGIN" "IF" A "THEN" "BEGIN" KAJ := VAJ / DAJ; ZAK := ZAJ - KAJ * (1 + ZAJ * KAJ * KAJ) "END" "ELSE" "BEGIN" KAJ := DAJ / (ZAJ * VAJ); ZAK := ZAJ - KAJ * (1 + KAJ * (KAJ * ZAJ + 1 / ZAJ)) "END"; "IF" D <= 1 "THEN" AIRY(ZAK,VAJ,DAJ,C,E,ZZ,"FALSE") "ELSE" AIRY(ZAK,C,E,VAJ,DAJ,ZZ,"FALSE"); FOUND := ABS(ZAK - ZAJ) < "-14 * ABS(ZAK) "OR" ABS("IF" A "THEN" VAJ "ELSE" DAJ) < "-12; ZAJ := ZAK "END"; VAI[I] := "IF" A "THEN" DAJ "ELSE" VAJ; ZAI[I] := ZAJ; "END"; AIRYZEROS := ZAI[N]; "END" AIRYZEROS; "COMMENT" ================== 31040 =================; "REAL" "PROCEDURE" POL(N,X,A); "VALUE" N,X;"INTEGER" N;"REAL" X;"ARRAY" A; "BEGIN" "REAL" R; R:= 0; "FOR" N:= N "STEP" -1 "UNTIL" 0 "DO" R:=R*X + A[N]; POL:= R "END" POL; "COMMENT" ================== 31241 =================; "PROCEDURE" TAYPOL(N,K,X,A); "VALUE" N,K,X; "INTEGER" N,K;"REAL" X;"ARRAY" A; "IF" X^= 0 "THEN" "BEGIN" "INTEGER" I,J,NM1; "REAL" XJ,AA,H; XJ:=1; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" XJ:=XJ*X;A[J]:=A[J]*XJ "END"; AA:=A[N];NM1:=N-1; "FOR" J:= 0 "STEP" 1 "UNTIL" K "DO" "BEGIN" H:=AA; "FOR" I:= NM1 "STEP" -1 "UNTIL" J "DO" H:= A[ I]:=A[I]+H "END" "END" "ELSE" "FOR" K:= K "STEP" -1 "UNTIL" 1 "DO" A[K]:=0; "COMMENT" ================== 31242 =================; "PROCEDURE" NORDERPOL (N,K,X,A); "VALUE" N,K,X; "INTEGER" N,K;"REAL" X;"ARRAY" A; "IF" X^= 0 "THEN" "BEGIN" "INTEGER" I,J,NM1; "REAL" XJ,AA,H; "ARRAY" XX[0:N]; XJ:=1; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" XJ:=XX[J]:=XJ*X;A[J]:=A[J]*XJ "END"; H:=AA:=A[N];NM1:=N-1; "FOR" I:= NM1 "STEP" -1 "UNTIL" 0 "DO" H:= A[I]:=A[I]+H; "FOR" J:= 1 "STEP" 1 "UNTIL" K "DO" "BEGIN" H:=AA; "FOR" I:= NM1 "STEP" -1 "UNTIL" J "DO" H:= A[ I]:=A[I]+H; A[J]:=H/XX[J] "END" "END" NORDERPOL ; "COMMENT" ================== 31243 =================; "PROCEDURE" DERPOL (N,K,X,A); "VALUE" N,K,X; "INTEGER" N,K;"REAL" X;"ARRAY" A; "BEGIN" "INTEGER" J; "REAL" FAC; "PROCEDURE"NORDERPOL(N,K,X,A);"CODE" 31242; FAC:=1; NORDERPOL (N,K,X,A); "FOR" J:= 2 "STEP" 1 "UNTIL" K "DO" "BEGIN" FAC:=FAC*J;A[J]:=A[J]*FAC "END" "END" DERPOL ; "COMMENT" ================== 32075 =================; "REAL" "PROCEDURE" TRICUB(XI,YI,XJ,YJ,XK,YK,G,RE,AE); "VALUE" XI,YI,XJ,YJ,XK,YK,RE,AE; "REAL" XI,YI,XJ,YJ,XK,YK,RE,AE; "REAL" "PROCEDURE" G; "BEGIN" "REAL" SURF,SURFMIN,XZ,YZ,GI,GJ,GK; "REAL" "PROCEDURE" INT(AX1,AY1,AF1,AX2,AY2,AF2,AX3,AY3,AF3, BX1,BY1,BF1,BX2,BY2,BF2,BX3,BY3,BF3, PX,PY,PF); "VALUE" BX1,BY1,BF1,BX2,BY2,BF2,BX3,BY3,BF3,PX,PY,PF; "REAL" BX1,BY1,BF1,BX2,BY2,BF2,BX3,BY3,BF3,PX,PY,PF, AX1,AY1,AF1,AX2,AY2,AF2,AX3,AY3,AF3; "BEGIN" "REAL" E,I3,I4,I5,A,B,C,SX1,SY1,SX2,SY2,SX3,SY3, CX1,CY1,CF1,CX2,CY2,CF2,CX3,CY3,CF3, DX1,DY1,DF1,DX2,DY2,DF2,DX3,DY3,DF3; A:= AF1 + AF2 + AF3; B:= BF1 + BF2 + BF3; I3:= 3 * A + 27 * PF + 8 * B; E:= ABS(I3) * RE + AE; "IF" SURF < SURFMIN "OR" ABS(5 * A + 45 * PF - I3) < E "THEN" INT:= I3 * SURF "ELSE" "BEGIN" CX1:= AX1 + PX; CY1:= AY1 + PY; CF1:= G(CX1,CY1); CX2:= AX2 + PX; CY2:= AY2 + PY; CF2:= G(CX2,CY2); CX3:= AX3 + PX; CY3:= AY3 + PY; CF3:= G(CX3,CY3); C:= CF1 + CF2 + CF3; I4:= A + 9 * PF + 4 * B + 12 * C; "IF" ABS(I3 - I4) < E "THEN" INT:= I4 * SURF "ELSE" "BEGIN" SX1:= .5 * BX1; SY1:= .5 * BY1; DX1:= AX1 + SX1; DY1:= AY1 + SY1; DF1:= G(DX1,DY1); SX2:= .5 * BX2; SY2:= .5 * BY2; DX2:= AX2 + SX2; DY2:= AY2 + SY2; DF2:= G(DX2,DY2); SX3:= .5 * BX3; SY3:= .5 * BY3; DX3:= AX3 + SX3; DY3:= AY3 + SY3; DF3:= G(DX3,DY3); I5:= (51 * A + 2187 * PF + 276 * B + 972 * C - 768 * (DF1 + DF2 + DF3))/63; "IF" ABS(I4 - I5) < E "THEN" INT:= I5 * SURF "ELSE" "BEGIN" SURF:= .25 * SURF; INT:= INT(SX1,SY1,BF1,SX2,SY2,BF2,SX3,SY3,BF3, DX1,DY1,DF1,DX2,DY2,DF2,DX3,DY3,DF3, PX,PY,PF) + INT(AX1,AY1,AF1,SX3,SY3,BF3,SX2,SY2,BF2,DX1,DY1,DF1, AX1 + SX2,AY1 + SY2,G(AX1 + SX2,AY1 + SY2), AX1 + SX3,AY1 + SY3,G(AX1 + SX3,AY1 + SY3), .5 * CX1,.5 * CY1,CF1) + INT(AX2,AY2,AF2,SX3,SY3,BF3,SX1,SY1,BF1,DX2,DY2,DF2, AX2 + SX1,AY2 + SY1,G(AX2 + SX1,AY2 + SY1), AX2 + SX3,AY2 + SY3,G(AX2 + SX3,AY2 + SY3), .5 * CX2,.5 * CY2,CF2) + INT(AX3,AY3,AF3,SX1,SY1,BF1,SX2,SY2,BF2,DX3,DY3,DF3, AX3 + SX2,AY3 + SY2,G(AX3 + SX2,AY3 + SY2), AX3 + SX1,AY3 + SY1,G(AX3 + SX1,AY3 + SY1), .5 * CX3,.5 * CY3,CF3); SURF:= 4 * SURF "END" "END" "END" "END" INT; SURF:= 0.5 * ABS(XJ * YK - XK * YJ + XI * YJ - XJ * YI + XK * YI - XI * YK); SURFMIN:= SURF*RE; RE:= 30*RE; AE:= 30*AE/SURF; XZ:= (XI + XJ + XK)/3; YZ:= (YI + YJ + YK)/3; GI:= G(XI,YI); GJ:= G(XJ,YJ); GK:= G(XK,YK); XI:= XI*.5; YI:= YI*.5; XJ:= XJ*.5; YJ:= YJ*.5; XK:= XK*.5; YK:= YK*.5; TRICUB:= INT(XI,YI,GI,XJ,YJ,GJ,XK,YK,GK, XJ+XK,YJ+YK,G(XJ+XK,YJ+YK), XK+XI,YK+YI,G(XK+XI,YK+YI), XI+XJ,YI+YJ,G(XI+XJ,YI+YJ), .5 * XZ,.5 * YZ,G(XZ,YZ))/60 "END" TRICUB; "COMMENT" ================== 34444 =================; "PROCEDURE" PEIDE(N,M,NOBS,NBP,PAR,RES,BP,JTJINV,IN,OUT,DERIV,JAC DFDY, JAC DFDP, CALL YSTART,DATA,MONITOR); "VALUE" N,M,NOBS; "INTEGER" N,M,NOBS,NBP; "ARRAY" PAR,RES,JTJINV,IN,OUT; "INTEGER" "ARRAY" BP; "PROCEDURE" CALL YSTART,DATA,MONITOR; "BOOLEAN" "PROCEDURE" DERIV,JAC DFDY,JACDFDP; "BEGIN" "INTEGER" I,J,EXTRA,WEIGHT,NCOL,NROW,AWAY,NPAR,II,JJ,MAX, NFE,NIS; "REAL" EPS,EPS1,XEND,C,X,T,HMIN,HMAX,RES1,IN3,IN4,FAC3,FAC4; "ARRAY" AUX[1:3],OBS[1:NOBS],SAVE[-38:6*N],TOBS[0:NOBS], YP[1:NBP+NOBS,1:NBP+M],YMAX[1:N],Y[1:6*N*(NBP+M+1)],FY[1:N,1:N], FP[1:N,1:M+NBP]; "INTEGER" "ARRAY" COBS[1:NOBS]; "BOOLEAN" FIRST,SEC,CLEAN; "PROCEDURE" INIVEC(L,U,A,X); "CODE" 31010; "PROCEDURE" INIMAT(L1,U1,L2,U2,A,X); "CODE" 31011; "PROCEDURE" MULVEC(L,U,S,A,B,X); "CODE" 31020; "PROCEDURE" MULROW(L,U,I,J,A,B,X); "CODE" 31021; "PROCEDURE" DUPVEC(L,U,S,A,B); "CODE" 31030; "PROCEDURE" DUPMAT(L1,U1,L2,U2,A,B); "CODE" 31035; "REAL" "PROCEDURE" VECVEC(L,U,S,A,B); "CODE" 34010; "REAL" "PROCEDURE" MATVEC(L,U,I,A,B); "CODE" 34011; "PROCEDURE" ELMVEC(L,U,S,A,B,X); "CODE" 34020; "PROCEDURE" SOL(A,N,P,B); "CODE" 34051; "PROCEDURE" DEC(A,N,AUX,P); "CODE" 34300; "PROCEDURE" MARQUARDT(M,N,P,R,C,F,J,I,O); "CODE" 34440; "REAL" "PROCEDURE" INTERPOL(STARTINDEX,JUMP,K,TOBSDIF); "VALUE" STARTINDEX,JUMP,K,TOBSDIF; "INTEGER" STARTINDEX,JUMP,K; "REAL" TOBSDIF; "BEGIN" "INTEGER" I; "REAL" S,R; S:=Y[STARTINDEX]; R:=TOBSDIF; "FOR" I:=1 "STEP" 1 "UNTIL" K "DO" "BEGIN" STARTINDEX:=STARTINDEX+JUMP; S:=S+Y[STARTINDEX]*R; R:=R*TOBSDIF "END"; INTERPOL:=S "END" INTERPOL; "PROCEDURE" JAC DYDP(NROW,NCOL,PAR,RES,JAC,LOCFUNCT); "VALUE" NROW,NCOL; "INTEGER" NROW,NCOL; "ARRAY" PAR,RES,JAC; "PROCEDURE" LOCFUNCT; "BEGIN" DUPMAT(1,NROW,1,NCOL,JAC,YP) "END" JACOBIAN; "BOOLEAN" "PROCEDURE" FUNCT(NROW,NCOL,PAR,RES); "VALUE" NROW,NCOL; "INTEGER" NROW,NCOL; "ARRAY" PAR,RES; "BEGIN" "INTEGER" L,K,KNEW,FAILS,SAME,KPOLD,N6,NNPAR,J5N, COBSII; "REAL" XOLD,HOLD,A0,TOLUP,TOL,TOLDWN,TOLCONV,H,CH,CHNEW, ERROR,DFI,TOBSDIF; "BOOLEAN" EVALUATE,EVALUATED,DECOMPOSE,CONV; "ARRAY" A[0:5],DELTA,LAST DELTA,DF,Y0[1:N],JACOB[1:N,1:N]; "INTEGER" "ARRAY" P[1:N]; "REAL" "PROCEDURE" NORM2(AI); "REAL" AI; "BEGIN" "REAL" S,A; S:= "-100; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" A:= AI/YMAX[I]; S:= S + A * A "END"; NORM2:= S "END" NORM2; "PROCEDURE" RESET; "BEGIN" "IF" CH < HMIN/HOLD "THEN" CH:= HMIN/HOLD "ELSE" "IF" CH > HMAX/HOLD "THEN" CH:= HMAX/HOLD; X:= XOLD; H:= HOLD * CH; C:= 1; "FOR" J:= 0 "STEP" N "UNTIL" K*N "DO" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" Y[J+I]:= SAVE[J+I] * C; C:= C * CH "END"; DECOMPOSE:="TRUE" "END" RESET; "PROCEDURE" ORDER; "BEGIN" C:= EPS * EPS; J:= (K-1) * (K + 8)/2 - 38; "FOR" I:= 0 "STEP" 1 "UNTIL" K "DO" A[I]:= SAVE[I+J]; J:= J + K + 1; TOLUP := C * SAVE[J]; TOL := C * SAVE[J + 1]; TOLDWN := C * SAVE[J + 2]; TOLCONV:= EPS/(2 * N * (K + 2)); A0:= A[0]; DECOMPOSE:= "TRUE"; "END" ORDER; "PROCEDURE" EVALUATE JACOBIAN; "BEGIN" EVALUATE:= "FALSE"; DECOMPOSE:= EVALUATED:= "TRUE"; "IF" "NOT" JAC DFDY(PAR,Y,X,FY) "THEN" "BEGIN" SAVE[-3]:=4; "GOTO" RETURN "END"; "END" EVALUATE JACOBIAN; "PROCEDURE" DECOMPOSE JACOBIAN; "BEGIN" DECOMPOSE:= "FALSE"; C:= -A0 * H; "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" JACOB[I,J]:= FY[I,J] * C; JACOB[J,J]:= JACOB[J,J] + 1 "END"; DEC(JACOB,N,AUX,P) "END" DECOMPOSE JACOBIAN; "PROCEDURE" CALCULATE STEP AND ORDER; "BEGIN" "REAL" A1,A2,A3; A1:= "IF" K <= 1 "THEN" 0 "ELSE" 0.75 * (TOLDWN/NORM2(Y[K*N+I])) ** (0.5/K); A2:= 0.80 * (TOL/ERROR) ** (0.5/(K + 1)); A3:= "IF" K >= 5 "OR" FAILS ^= 0 "THEN" 0 "ELSE" 0.70 * (TOLUP/NORM2(DELTA[I] - LAST DELTA[I]))** (0.5/(K+2)); "IF" A1 > A2 "AND" A1 > A3 "THEN" "BEGIN" KNEW:= K-1; CHNEW:= A1 "END" "ELSE" "IF" A2 > A3 "THEN" "BEGIN" KNEW:= K ; CHNEW:= A2 "END" "ELSE" "BEGIN" KNEW:= K+1; CHNEW:= A3 "END" "END" CALCULATE STEP AND ORDER; "IF" SEC "THEN" "BEGIN" SEC:="FALSE"; "GOTO" RETURN "END"; NPAR:=M; EXTRA:=NIS:=0; II:=1; JJ:="IF" NBP=0 "THEN" 0 "ELSE" 1; N6:=N*6; INIVEC(-3,-1,SAVE,0); INIVEC(N6+1,(6+M)*N,Y,0); INIMAT(1,NOBS+NBP,1,M+NBP,YP,0); T:=TOBS[1]; X:=TOBS[0]; CALL YSTART(PAR,Y,YMAX); HMAX:=TOBS[1]-TOBS[0]; HMIN:=HMAX*IN[1]; EVALUATE JACOBIAN; NNPAR:=N*NPAR; NEW START: K:= 1; KPOLD:=0; SAME:= 2; ORDER; "IF" "NOT" DERIV(PAR,Y,X,DF) "THEN" "BEGIN" SAVE[-3]:=3; "GOTO" RETURN "END"; H:=SQRT(2 * EPS/SQRT(NORM2 (MATVEC(1,N,I,FY,DF)))); "IF" H > HMAX "THEN" H:= HMAX "ELSE" "IF" H < HMIN "THEN" H:= HMIN; XOLD:= X; HOLD:= H; CH:= 1; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" SAVE[I]:=Y[I]; SAVE[N+I]:=Y[N+I]:=DF[I]*H "END"; FAILS:= 0; "FOR" L:= 0 "WHILE" X < XEND "DO" "BEGIN" "IF" X + H <= XEND "THEN" X:= X + H "ELSE" "BEGIN" H:= XEND-X; X:= XEND; CH:= H/HOLD; C:= 1; "FOR" J:= N "STEP" N "UNTIL" K*N "DO" "BEGIN" C:= C* CH; "FOR" I:= J+1 "STEP" 1 "UNTIL" J+N "DO" Y[I]:= Y[I] * C "END"; SAME:= "IF" SAME<3 "THEN" 3 "ELSE" SAME+1; "END"; "COMMENT" PREDICTION; "FOR" L:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" "FOR" I:= L "STEP" N "UNTIL" (K-1)*N+L "DO" "FOR" J:= (K-1)*N+L "STEP" -N "UNTIL" I "DO" Y[J]:= Y[J] + Y[J+N]; DELTA[L]:= 0 "END"; EVALUATED:= "FALSE"; "COMMENT" CORRECTION AND ESTIMATION LOCAL ERROR; "FOR" L:= 1,2,3 "DO" "BEGIN" "IF" "NOT" DERIV(PAR,Y,X,DF) "THEN" "BEGIN" SAVE[-3]:=3; "GOTO" RETURN "END"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" DF[I]:= DF[I] * H - Y[N+I]; "IF" EVALUATE "THEN" EVALUATE JACOBIAN; "IF" DECOMPOSE "THEN" DECOMPOSE JACOBIAN; SOL(JACOB,N,P,DF); CONV:= "TRUE"; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" DFI:= DF[I]; Y[ I]:= Y[ I] + A0 * DFI; Y[N+I]:= Y[N+I] + DFI; DELTA[I]:= DELTA[I] + DFI; CONV:= CONV "AND" ABS(DFI) < TOLCONV * YMAX[I] "END"; "IF" CONV "THEN" "BEGIN" ERROR:= NORM2(DELTA[I]); "GOTO" CONVERGENCE "END" "END"; "COMMENT" ACCEPTANCE OR REJECTION; "IF" "NOT" CONV "THEN" "BEGIN" "IF" "NOT" EVALUATED "THEN" EVALUATE:= "TRUE" "ELSE" "BEGIN" CH:=CH/4; "IF" H<4*HMIN "THEN" "BEGIN" SAVE[-1]:= SAVE[-1]+10; HMIN:=HMIN/10; "IF" SAVE[-1]>40 "THEN" "GOTO" RETURN "END" "END"; RESET "END" "ELSE" CONVERGENCE: "IF" ERROR > TOL "THEN" "BEGIN" FAILS:= FAILS + 1; "IF" H > 1.1 * HMIN "THEN" "BEGIN" "IF" FAILS > 2 "THEN" "BEGIN" RESET; "GOTO" NEW START "END" "ELSE" "BEGIN" CALCULATE STEP AND ORDER; "IF" KNEW ^= K "THEN" "BEGIN" K:= KNEW; ORDER "END"; CH:= CH * CHNEW; RESET "END" "END" "ELSE" "BEGIN" "IF" K = 1 "THEN" "BEGIN" "COMMENT" VIOLATE EPS CRITERION; SAVE[-2]:= SAVE[-2] + 1; SAME:= 4; "GOTO" ERROR TEST OK "END"; K:=1; RESET; ORDER; SAME:= 2 "END" "END" "ELSE" ERROR TEST OK: "BEGIN" FAILS:= 0; "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO" "BEGIN" C:= DELTA[I]; "FOR" L:= 2 "STEP" 1 "UNTIL" K "DO" Y[L*N+I]:= Y[L*N+I] + A[L] * C; "IF" ABS(Y[I]) > YMAX[I] "THEN" YMAX[I]:= ABS(Y[I]) "END"; SAME:= SAME-1; "IF" SAME= 1 "THEN" DUPVEC(1,N,0,LAST DELTA,DELTA) "ELSE" "IF" SAME= 0 "THEN" "BEGIN" CALCULATE STEP AND ORDER; "IF" CHNEW > 1.1 "THEN" "BEGIN" "IF" K ^= KNEW "THEN" "BEGIN" "IF" KNEW > K "THEN" MULVEC(KNEW*N+1,KNEW*N+N,-KNEW*N,Y,DELTA, A[K]/KNEW); K:= KNEW; ORDER "END"; SAME:= K+1; "IF" CHNEW * H > HMAX "THEN" CHNEW:= HMAX/H; H:= H * CHNEW; C:= 1; "FOR" J:= N "STEP" N "UNTIL" K*N "DO" "BEGIN" C:= C * CHNEW; MULVEC(J+1,J+N,0,Y,Y,C) "END"; DECOMPOSE:="TRUE" "END" "ELSE" SAME:= 10 "END" OF A SINGLE INTEGRATION STEP OF Y; NIS:=NIS+1; "COMMENT" START OF A INTEGRATION STEP OF YP; "IF" CLEAN "THEN" "BEGIN" HOLD:=H; XOLD:=X; KPOLD:=K; CH:=1; DUPVEC(1,K*N+N,0,SAVE,Y) "END" "ELSE" "BEGIN" "IF" H^=HOLD "THEN" "BEGIN" CH:=H/HOLD; C:=1; "FOR" J:=N6+NNPAR "STEP" NNPAR "UNTIL" KPOLD*NNPAR+N6 "DO" "BEGIN" C:=C*CH; "FOR" I:=J+1 "STEP" 1 "UNTIL" J+NNPAR "DO" Y[I]:=Y[I]*C "END"; HOLD:=H "END"; "IF" K>KPOLD "THEN" INIVEC(N6+K*NNPAR+1,N6+K*NNPAR+NNPAR,Y,0); XOLD:= X; KPOLD:= K; CH:= 1; DUPVEC(1,K*N+N,0,SAVE,Y); EVALUATE JACOBIAN; DECOMPOSE JACOBIAN; "IF" "NOT" JAC DFDP(PAR,Y,X,FP) "THEN" "BEGIN" SAVE[-3]:=5; "GOTO" RETURN "END"; "IF" NPAR>M "THEN" INIMAT(1,N,M+1,NPAR,FP,0); "COMMENT" PREDICTION; "FOR" L:=0 "STEP" 1 "UNTIL" K-1 "DO" "FOR" J:=K-1 "STEP" -1 "UNTIL" L "DO" ELMVEC(J*NNPAR+N6+1,J*NNPAR+N6+NNPAR,NNPAR,Y,Y,1); "COMMENT" CORRECTION; "FOR" J:=1 "STEP" 1 "UNTIL" NPAR "DO" "BEGIN" J5N:=(J+5)*N; DUPVEC(1,N,J5N,Y0,Y); "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" DF[I]:= H*(FP[I,J]+MATVEC(1,N,I,FY,Y0)) -Y[NNPAR+J5N+I]; SOL(JACOB,N,P,DF); "FOR" L:=0 "STEP" 1 "UNTIL" K "DO" "BEGIN" I:=L*NNPAR+J5N; ELMVEC(I+1,I+N,-I,Y,DF,A[L]) "END" "END" "END"; "FOR" L:=0 "WHILE" X>=T "DO" "BEGIN" "COMMENT" CALCULATION OF A ROW OF THE JACOBIAN MATRIX AND AN ELEMENT OF THE RESIDUAL VECTOR; TOBSDIF:=(TOBS[II]-X)/H; COBSII:=COBS[II]; RES[II]:=INTERPOL(COBSII,N,K,TOBSDIF)-OBS[II]; "IF" "NOT" CLEAN "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" NPAR "DO" YP[II,I]:=INTERPOL(COBSII+(I+5)*N,NNPAR,K, TOBSDIF); "COMMENT" INTRODUCING OF BREAK-POINTS; "IF" BP[JJ]^=II "THEN" "ELSE" "IF" FIRST "AND" ABS(RES[II])0 "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" "BEGIN" Y[I]:=INTERPOL(I,N,K,TOBSDIF); "FOR" J:=1 "STEP" 1 "UNTIL" NPAR "DO" Y[I+(J+5)*N]:=INTERPOL(I+(J+5)*N,NNPAR,K, TOBSDIF) "END"; "FOR" L:=1 "STEP" 1 "UNTIL" EXTRA "DO" "BEGIN" COBSII:=COBS[BP[NPAR-M+L]]; Y[COBSII]:=PAR[NPAR+L]; "FOR" I:=1 "STEP" 1 "UNTIL" NPAR+EXTRA "DO" Y[COBSII+(5+I)*N]:=0; INIVEC(1+NNPAR+(L+5)*N,NNPAR+(L+6)*N,Y,0); Y[COBSII+(5+NPAR+L)*N]:=1 "END"; NPAR:=NPAR+EXTRA; EXTRA:=0; X:=TOBS[II-1]; EVALUATE JACOBIAN; NNPAR:=N*NPAR; "GOTO" NEW START "END" "END" "END" STEP; RETURN: "IF" SAVE[-2]>MAX "THEN" MAX:=SAVE[-2]; FUNCT:=SAVE[-1]<=40 "AND" SAVE[-3]=0; "IF" "NOT" FIRST "THEN" MONITOR(1,NCOL,NROW,PAR,RES,WEIGHT,NIS) "END" FUNCT; I:= -39; "FOR" C:= 1,1,9,4,0,2/3,1,1/3,36,20.25,1,6/11, 1,6/11,1/11,84.028,53.778,0.25,.48,1,.7,.2,.02, 156.25, 108.51, .027778, 120/274, 1, 225/274, 85/274, 15/274, 1/274, 0, 187.69, .0047361 "DO" "BEGIN" I:= I + 1; SAVE[I]:= C "END"; DATA(NOBS,TOBS,OBS,COBS); WEIGHT:=1; FIRST:=SEC:="FALSE"; CLEAN:=NBP>0; AUX[2]:="-12; EPS:=IN[2]; EPS1:="10; XEND:=TOBS[NOBS]; OUT[1]:=0; BP[0]:=MAX:=0; "COMMENT" SMOOTH INTEGRATION WITHOUT BREAK-POINTS; "IF" "NOT" FUNCT(NOBS,M,PAR,RES) "THEN" "GOTO" ESCAPE; RES1:=SQRT(VECVEC(1,NOBS,0,RES,RES)); NFE:=1; "IF" IN[5]=1 "THEN" "BEGIN" OUT[1]:=1; "GOTO" ESCAPE "END"; "IF" CLEAN "THEN" "BEGIN" FIRST:="TRUE"; CLEAN:="FALSE"; FAC3:=SQRT(SQRT(IN[3]/RES1)); FAC4:=SQRT(SQRT(IN[4]/RES1)); EPS1:=RES1*FAC4; "IF" "NOT" FUNCT(NOBS,M,PAR,RES) "THEN" "GOTO" ESCAPE; FIRST:="FALSE" "END" "ELSE" NFE:=0; NCOL:=M+NBP; NROW:=NOBS+NBP; SEC:="TRUE"; IN3:=IN[3]; IN4:=IN[4]; IN[3]:=RES1; "BEGIN" "REAL" W; "ARRAY" AID[1:NCOL,1:NCOL]; WEIGHT:=AWAY:=0; OUT[4]:=OUT[5]:=W:=0; "FOR" WEIGHT:=(SQRT(WEIGHT)+1)**2 "WHILE" WEIGHT^=16 "AND" NBP>0 "DO" "BEGIN" "IF" AWAY=0 "AND" W^=0 "THEN" "BEGIN" "COMMENT" IF NO BREAK-POINTS WERE OMITTED THEN ONE FUNCTION EVALUATION IS SAVED; W:=WEIGHT/W; "FOR" I:=NOBS+1 "STEP" 1 "UNTIL" NROW "DO" "BEGIN" "FOR" J:=1 "STEP" 1 "UNTIL" NCOL "DO" YP[I,J]:=W*YP[I,J]; RES[I]:=W*RES[I] "END"; SEC:="TRUE"; NFE:=NFE-1 "END"; IN[3]:=IN[3]*FAC3*WEIGHT; IN[4]:=EPS1; MONITOR(2,NCOL,NROW,PAR,RES,WEIGHT,NIS); MARQUARDT(NROW,NCOL,PAR,RES,AID,FUNCT,JAC DYDP,IN,OUT); "IF" OUT[1]>0 "THEN" "GOTO" ESCAPE; "COMMENT" THE RELATIVE STARTING VALUE OF LAMBDA IS ADJUSTED TO THE LAST VALUE OF LAMBDA USED; AWAY:=OUT[4]-OUT[5]-1; IN[6]:=IN[6] * 5**AWAY * 2**(AWAY-OUT[5]); NFE:=NFE+OUT[4]; W:=WEIGHT; EPS1:=(SQRT(WEIGHT)+1)**2*IN[4]*FAC4; AWAY:=0; "COMMENT" USELESS BREAK-POINTS ARE OMITTED; "FOR" J:=1 "STEP" 1 "UNTIL" NBP "DO" "BEGIN" "IF" ABS(OBS[BP[J]]+RES[BP[J]]-PAR[J+M])= 0 "DO" "BEGIN" PP:= SUB[L]; PP:= PP/(CH - PP); TL:= T[L]; CH:= TL - CH*PP; YL:= Y[L]; G:= YL - G*PP; Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL) "END" "END" BACKWARD BABUSHKA; L:= 0; XL:= X[0]; E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6]; "FOR" L:= L + 1 "WHILE" L <= N "DO" "BEGIN" L1:= L - 1; XL1:= XL; XL:= X[L]; H:= XL - XL1; "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE" "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE" ELEMENT MAT VEC EVALUATION 3; "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS; FORWARD BABUSHKA "END"; BACKWARD BABUSHKA; "END" FEM LAG SYM; "COMMENT" ================== 33301 =================; "PROCEDURE" FEM LAG(X, Y, N, R, F, ORDER, E); "VALUE" N, ORDER; "INTEGER" N, ORDER; "REAL" "PROCEDURE" R, F; "ARRAY" X, Y, E; "BEGIN" "INTEGER" L, L1; "REAL" XL1, XL, H, A12, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP, E1, E2, E3, E4, E5, E6; "ARRAY" T, SUB, CHI, GI[0: N-1]; "PROCEDURE" ELEMENT MAT VEC EVALUATION 1; "BEGIN" "OWN" "REAL" F2, R2; "REAL" R1, F1, H2; "IF" L=1 "THEN" "BEGIN" F2:= F(XL1); R2:= R(XL1) "END"; A12:= - 1/H; H2:= H/2; R1:= R2; R2:= R(XL); F1:= F2; F2:= F(XL); B1:= H2*F1; B2:= H2*F2; TAU1:= H2*R1; TAU2:= H2*R2 "END" ELEMENT MAT VEC EVALUATION 1; "PROCEDURE" ELEMENT MAT VEC EVALUATION 2; "BEGIN" "OWN" "REAL" R3, F3; "REAL" R1, R2, F1, F2, X2, H6, H15, B3, TAU3, C12, A13, A22, A23; "IF" L=1 "THEN" "BEGIN" R3:= R(XL1); F3:= F(XL1) "END"; X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5; R1:= R3; R2:= R(X2); R3:= R(XL); F1:= F3; F2:= F(X2); F3:= F(XL); B1:= H6*F1; B2:= H15*F2; B3:= H6*F3; TAU1:= H6*R1; TAU2:= H15*R2; TAU3:= R3*H6; A12:= A23:= -8/H/3; A13:= - A12/8; A22:= -2*A12 + TAU2; "COMMENT" STATIC CONDENSATION; C12:= - A12/A22; A12:= A13 + C12*A12; B2:= C12*B2; B1:= B1 + B2; B2:= B3 + B2; TAU2:= C12*TAU2; TAU1:= TAU1 + TAU2; TAU2:= TAU3 + TAU2 "END" ELEMENT MAT VEC EVALUATION2; "PROCEDURE" ELEMENT MAT VEC EVALUATION 3; "BEGIN" "OWN" "REAL" R4, F4; "REAL" R1, R2, R3, F1, F2, F3, X2, X3, H12, H24, DET, C12, C13, C42, C43, A13, A14, A22, A23, A24, A33, A34, B3, B4, TAU3, TAU4; "IF" L=1 "THEN" "BEGIN" R4:= R(XL1); F4:= F(XL1) "END"; X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1; R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL); F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL); H12:= H/12; H24:= H/2.4; B1:= F1*H12; B2:= F2*H24; B3:= F3*H24; B4:= F4*H12; TAU1:= R1*H12; TAU2:= R2*H24; TAU3:= R3*H24; TAU4:= R4*H12; A12:= A34:= -4.8784183052078/H; A13:= A24:= 0.7117516385412/H; A14:= -0.16666666666667/H; A23:= 25*A14; A22:= -2*A23 + TAU2; A33:= -2*A23 + TAU3; "COMMENT" STATIC CONDENSATION; DET:= A22*A33 - A23*A23; C12:= (A13*A23 - A12*A33)/DET; C13:= (A12*A23 - A13*A22)/DET; C42:= (A23*A34 - A24*A33)/DET; C43:= (A24*A23 - A34*A22)/DET; TAU1:= TAU1 + C12*TAU2 + C13*TAU3; TAU2:= TAU4 + C42*TAU2 + C43*TAU3; A12:= A14 + C42*A12 + C43*A13; B1:= B1 + C12*B2 + C13*B3; B2:= B4 + C42*B2 + C43*B3 "END" ELEMENT MAT VEC EVALUATION3; "PROCEDURE" BOUNDARY CONDITIONS; "IF" L=1 "AND" E2 = 0 "THEN" "BEGIN" TAU1:= 1; B1:= E3/E1; B2:= B2 - A12*B1; TAU2:= TAU2 - A12; A12:= 0 "END" "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN" "BEGIN" TAU1:= TAU1 - E1/E2; B1:= B1 - E3/E2 "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN" "BEGIN" TAU2:= 1; B2:= E6/E4; B1:= B1 - A12*B2; TAU1:= TAU1 - A12; A12:= 0 "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN" "BEGIN" TAU2:= TAU2 + E4/E5; B2:= B2 + E6/E5 "END" BOUNDARY CONDITIONS; "PROCEDURE" FORWARD BABUSHKA; "IF" L=1 "THEN" "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL; GI[0]:= G:= YL:= B1; Y[0]:= YL; SUB[0]:= A12; PP:= A12/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; TL:= TAU2; YL:= B2 "END" "ELSE" "BEGIN" CHI[L1]:= CH:= CH + TAU1; GI[L1]:= G:= G + B1; SUB[L1]:= A12; PP:= A12/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; T[L1]:= TL + TAU1; TL:= TAU2; Y[L1]:= YL + B1; YL:= B2 "END" FORWARD BABUSHKA 1; "PROCEDURE" BACKWARD BABUSHKA; "BEGIN" PP:= YL; Y[N]:= G/CH; G:= PP; CH:= TL; L:= N; "FOR" L:= L - 1 "WHILE" L >= 0 "DO" "BEGIN" PP:= SUB[L]; PP:= PP/(CH - PP); TL:= T[L]; CH:= TL - CH*PP; YL:= Y[L]; G:= YL - G*PP; Y[L]:=((GI[L] + G) - YL)/((CHI[L] + CH) - TL) "END" "END" BACKWARD BABUSHKA; L:= 0; XL:= X[0]; E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6]; "FOR" L:= L + 1 "WHILE" L <= N "DO" "BEGIN" L1:= L - 1; XL1:= XL; XL:= X[L]; H:= XL - XL1; "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE" "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE" ELEMENT MAT VEC EVALUATION 3; "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS; FORWARD BABUSHKA "END"; BACKWARD BABUSHKA; "END" FEM LAGR; "COMMENT" ================== 33302 =================; "PROCEDURE" FEM LAG SKEW(X, Y, N, Q, R, F, ORDER, E); "INTEGER" N, ORDER; "REAL" "PROCEDURE" Q, R, F; "ARRAY" X, Y, E; "BEGIN" "INTEGER" L, L1; "REAL" XL1, XL, H, A12, A21, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP, E1, E2, E3, E4, E5, E6; "ARRAY" T, SUPER, SUB, CHI, GI[0:N-1]; "PROCEDURE" ELEMENT MAT VEC EVALUATION 1; "BEGIN" "OWN" "REAL" Q2, R2, F2; "REAL" Q1, R1, F1, H2, S12; "IF" L=1 "THEN" "BEGIN" Q2:= Q(XL1); R2:= R(XL1); F2:= F(XL1) "END"; H2:= H/2; S12:= - 1/H; Q1:= Q2; Q2:= Q(XL); R1:= R2; R2:= R(XL); F1:= F2; F2:= F(XL); B1:= H2*F1; B2:= H2*F2; TAU1:= H2*R1; TAU2:= H2*R2; A12:= S12 + Q1/2; A21:= S12 - Q2/2 "END" ELEMENT MAT VEC EV.; "PROCEDURE" ELEMENT MAT VEC EVALUATION 2; "BEGIN" "OWN" "REAL" Q3, R3, F3; "REAL" Q1, Q2, R1, R2, F1, F2, S12, S13, S22, X2, H6, H15, C12, C32, A13, A31, A22, A23, A32, B3, TAU3; "IF" L=1 "THEN" "BEGIN" Q3:= Q(XL1); R3:= R(XL1); F3:= F(XL1) "END"; X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5; Q1:= Q3; Q2:= Q(X2); Q3:= Q(XL); R1:= R3; R2:= R(X2); R3:= R(XL); F1:= F3; F2:= F(X2); F3:= F(XL); B1:= H6*F1; B2:= H15*F2; B3:= H6*F3; TAU1:= H6*R1; TAU2:= H15*R2; TAU3:= H6*R3; S12:= - 1/H/0.375; S13:= - S12/8; S22:= - 2*S12; A12:= S12 + Q1/1.5; A13:= S13 - Q1/6; A21:= S12 - Q2/1.5; A23:= S12 + Q2/1.5; A22:= S22 + TAU2; A31:= S13 + Q3/6; A32:= S12 - Q3/1.5; "COMMENT" STATIC CONDENSATION; C12:= - A12/A22; C32:= - A32/A22; A12:= A13 + C12*A23; A21:= A31 + C32*A21; B1:= B1 + C12*B2; B2:= B3 + C32*B2; TAU1:= TAU1 + C12*TAU2; TAU2:= TAU3 + C32*TAU2 "END" ELEMENT MAT VEC EVALUATION 2; "PROCEDURE" ELEMENT MAT VEC EVALUATION 3; "BEGIN" "OWN" "REAL" Q4, R4, F4; "REAL" Q1, Q2, Q3, R1, R2, R3, F1, F2, F3, S12, S13, S14, S22, S23, X2, X3, H12, H24, DET, C12, C13, C42, C43, A13, A14, A22, A23, A24, A31, A32, A33, A34, A41, A42, A43, B3, B4, TAU3, TAU4; "IF" L=1 "THEN" "BEGIN" Q4:= Q(XL1); R4:= R(XL1); F4:= F(XL1) "END"; X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1; H12:= H/12; H24:= H/2.4; Q1:= Q4; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(XL); R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL); F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL); S12:= -4.8784183052080/H; S13:= 0.7117516385414/H; S14:= -.16666666666667/H; S23:= 25*S14; S22:= -2*S23; B1:= H12*F1; B2:= H24*F2; B3:= H24*F3; B4:= H12*F4; TAU1:= H12*R1; TAU2:= H24*R2; TAU3:= H24*R3; TAU4:= H12*R4; A12:= S12 + 0.67418082864578*Q1; A13:= S13 - 0.25751416197912*Q1; A14:= S14 + Q1/12; A21:= S12 - 0.67418082864578*Q2; A22:= S22 + TAU2; A23:= S23 + 0.93169499062490*Q2; A24:= S13 - 0.25751416197912*Q2; A31:= S13 + 0.25751416197912*Q3; A32:= S23 - 0.93169499062490*Q3; A33:= S22 + TAU3; A34:= S12 + 0.67418082864578*Q3; A41:= S14 - Q4/12; A42:= S13 + 0.25751416197912*Q4; A43:= S12 - 0.67418082864578*Q4; "COMMENT" STATIC CONDENSATION; DET:= A22*A33 - A23*A32; C12:= (A13*A32 - A12*A33)/DET; C13:= (A12*A23 - A13*A22)/DET; C42:= (A32*A43 - A42*A33)/DET; C43:= (A42*A23 - A43*A22)/DET; TAU1:= TAU1 + C12*TAU2 + C13*TAU3 ; TAU2:= TAU4 + C42*TAU2 + C43*TAU3; A12:= A14 + C12*A24 + C13*A34; A21:= A41 + C42*A21 + C43*A31; B1:= B1 + C12*B2 + C13*B3; B2:= B4 + C42*B2 + C43*B3 "END" ELEMENT MAT VEC EVALUATION 3; "PROCEDURE" BOUNDARY CONDITIONS; "IF" L=1 "AND" E2 = 0 "THEN" "BEGIN" TAU1:= 1; B1:= E3/E1; A12:= 0 "END" "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN" "BEGIN" TAU1:= TAU1 - E1/E2; B1:= B1 - E3/E2 "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN" "BEGIN" TAU2:= 1; A21:= 0; B2:= E6/E4; "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN" "BEGIN" TAU2:= TAU2 + E4/E5; B2:= B2 + E6/E5 "END" B.C.1; "PROCEDURE" FORWARD BABUSKA; "IF" L=1 "THEN" "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL; GI[0]:= G:= YL:= B1; Y[0]:= YL; SUB[0]:= A21; SUPER[0]:= A12; PP:= A21/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; TL:= TAU2; YL:= B2 "END" "ELSE" "BEGIN" CHI[L1]:= CH:= CH + TAU1; GI[L1]:= G:= G + B1; SUB[L1]:= A21; SUPER[L1]:= A12; PP:= A21/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; T[L1]:= TL + TAU1; TL:= TAU2; Y[L1]:= YL + B1; YL:= B2 "END" FORWARD BABUSKA; "PROCEDURE" BACKWARD BABUSKA; "BEGIN"PP:= YL; Y[N]:= G/CH; G:= PP; CH:= TL; L:= N; "FOR" L:= L - 1 "WHILE" L >= 0 "DO" "BEGIN" PP:= SUPER[L]/(CH - SUB[L]); TL:= T[L]; CH:= TL - CH*PP; YL:= Y[L]; G:= YL - G*PP; Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL) ; "END" "END" BACKWARD BABUSKA; L:= 0; XL:= X[0]; E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6]; "COMMENT" ELEMENTWISE ASSEMBLAGE OF MATRIX AND VECTOR COMBINED WITH FORWARD BABUSKA SUBSTITUTION; "FOR" L:= L + 1 "WHILE" L <= N "DO" "BEGIN" XL1:= XL; L1:= L - 1; XL:= X[L]; H:= XL - XL1; "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE" "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE" ELEMENT MAT VEC EVALUATION 3; "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS; FORWARD BABUSKA "END"; BACKWARD BABUSKA; "END" FEM LAGR; "COMMENT" ================== 33303 =================; "PROCEDURE" FEM HERM SYM(X, Y, N, P, Q, R, F, ORDER, E); "VALUE" N, ORDER; "INTEGER" N, ORDER; "ARRAY" X, Y, E; "REAL" "PROCEDURE" P, Q, R, F; "BEGIN" "INTEGER" L, N2, V, W; "ARRAY" A[1:8*(N - 1)], EM[2:3]; "REAL" A11, A12, A13, A14, A22, A23, A24, A33, A34, A44, YA, YB, ZA, ZB, B1, B2, B3, B4, D1, D2, E1, R1, R2, XL1, XL; "PROCEDURE" CHLDECSOLBND(A, N, W, AUX, B); "CODE" 34333; "PROCEDURE" ELEMENTMATVECEVALUATION; "IF"ORDER=4"THEN" "BEGIN" "REAL" X2, H, H2, H3, P1, P2, Q1, Q2, R1, R2, F1, F2, B11, B12, B13, B14, B22, B23, B24, B33, B34, B44, S11, S12, S13, S14, S22, S23, S24, S33, S34, S44, M11, M12, M13, M14, M22, M23, M24, M33, M34, M44; "OWN" "REAL"P3, Q3, R3, F3; H:= XL - XL1; H2:= H*H; H3:= H*H2; X2:= (XL1 + XL)/2; "IF"L=1"THEN" "BEGIN"P3:= P(XL1); Q3:= Q(XL1); R3:= R(XL1); F3:= F(XL1) "END"; "COMMENT" ELEMENT BENDING MATRIX; P1:= P3; P2:= P(X2); P3:= P(XL); B11:= 6*(P1 + P3); B12:= 4*P1 + 2*P3; B13:= - B11; B14:= B11 - B12; B22:= (4*P1 + P2 + P3)/1.5; B23:= - B12; B24:= B12 - B22; B33:= B11; B34:= - B14; B44:= B14 - B24; "COMMENT" ELEMENT STIFFNESS MATRIX; Q1:= Q3; Q2:= Q(X2); Q3:= Q(XL); S11:= 1.5*Q2; S12:= Q2/4; S13:= - S11; S14:= S12; S24:= Q2/24; S22:= Q1/6 + S24; S23:= - S12; S33:= S11; S34:= - S12; S44:= S24 + Q3/6; "COMMENT" ELEMENT MASS MATRIX; R1:= R3; R2:= R(X2); R3:= R(XL); M11:= (R1 + R2)/6; M12:= R2/24; M13:= R2/6; M14:= - M12; M22:= R2/96; M23:= - M14; M24:= - M22; M33:= (R2 + R3)/6; M34:= M14; M44:= M22; "COMMENT" ELEMENT LOAD VECTOR; F1:= F3; F2:= F(X2); F3:= F(XL); B1:= H*(F1 + 2*F2)/6; B3:= H*(F3 + 2*F2)/6; B2:= H2*F2/12; B4:= - B2; A11:= B11/H3 + S11/H + M11*H; A12:= B12/H2 + S12 + M12*H2; A13:= B13/H3 + S13/H + M13*H; A14:= B14/H2 + S14 + M14*H2; A22:= B22/H + S22*H + M22*H3; A23:= B23/H2 + S23 + M23*H2; A24:= B24/H + S24*H + M24*H3; A34:= B34/H2 + S34 + M34*H2; A33:= B33/H3 + S33/H + M33*H; A44:= B44/H + S44*H + M44*H3 "END" "ELSE" "IF"ORDER=6"THEN" "BEGIN" "OWN" "REAL"P4, Q4, R4, F4; "REAL"H, H2, H3, X2, X3, P1, P2, P3, Q1, Q2, Q3, R1, R2, R3, F1, F2, F3, B11, B12, B13, B14, B15, B22, B23, B24, B25, B33, B34, B35, B44, B45, B55, S11, S12, S13, S14, S15, S22, S23, S24, S25, S33, S34, S35, S44, S45, S55, M11, M12, M13, M14, M15, M22, M23, M24, M25, M33, M34, M35, M44, M45, M55, A15, A25, A35, A45, A55, C1, C2, C3, C4, B5; "IF"L=1"THEN" "BEGIN"P4:= P(XL1); Q4:= Q(XL1); R4:= R(XL1); F4:= F(XL1) "END"; H:= XL - XL1; H2:= H*H; H3:= H*H2; X2:= 0.27639320225*H + XL1; X3:= XL1 + XL - X2; "COMMENT" ELEMENT BENDING MATRIX; P1:= P4; P2:= P(X2); P3:= P(X3); P4:= P(XL); B11:= + 4.0333333333333"+1*P1 + 1.1124913866738"-1*P2 + 1.4422084194664"+1*P3 + 8.3333333333333"+0*P4; B12:= + 1.4666666666667"+1*P1 - 3.3191425091659"-1*P2 + 2.7985809175818"+0*P3 + 1.6666666666667"+0*P4; B13:= + 1.8333333333333"+1*(P1+P4) + 1.2666666666667"+0*(P2+P3); B15:= - (B11 + B13); B14:= - (B12 + B13 + B15/2); B22:= + 5.3333333333333"+0*P1 + 9.9027346441674"-1*P2 + 5.4305986891624"-1*P3 + 3.3333333333333"-1*P4; B23:= + 6.6666666666667"+0*P1 - 3.7791278464167"+0*P2 + 2.4579451308295"-1*P3 + 3.6666666666667"+0*P4; B25:= - (B12 + B23); B24:= - (B22 + B23 + B25/2); B33:= + 8.3333333333333"+0*P1 + 1.4422084194666"+1*P2 + 1.1124913866726"-1*P3 + 4.0333333333333"+1*P4; B35:= - (B13 + B33); B34:= - (B23 + B33 + B35/2); B45:= - (B14 + B34); B44:= - (B24 + B34 + B45/2); B55:= - (B15 + B35); "COMMENT" ELEMENT STIFFNESS MATRIX; Q1:= Q4; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(XL); S11:= + 2.8844168389330"+0*Q2 + 2.2249827733448"-2*Q3; S12:= + 2.5671051872498"-1*Q2 + 3.2894812749994"-3*Q3; S13:= + 2.5333333333333"-1*(Q2+Q3); S14:= - 3.7453559925005"-2*Q2 - 2.2546440074988"-2*Q3; S15:= - (S13 + S11); S22:= + 8.3333333333333"-2*Q1 + 2.2847006554164"-2*Q2 + 4.8632677916445"-4*Q3; S23:= + 2.2546440075002"-2*Q2 + 3.7453559924873"-2*Q3; S24:= - 3.3333333333333"-3*(Q2+Q3); S25:= - (S12 + S23); S33:= + 2.2249827733471"-2*Q2 + 2.8844168389330"+0*Q3; S34:= - 3.2894812750127"-3*Q2 - 2.5671051872496"-1*Q3; S35:= - (S13 + S33); S44:= + 4.8632677916788"-4*Q2 + 2.2847006554161"-2*Q3 + 8.3333333333338"-2*Q4; S45:= - (S14 + S34); S55:= - (S15 + S35); "COMMENT" ELEMENT MASS MATRIX; R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL); M11:= + 8.3333333333333"-2*R1 + 1.0129076086083"-1*R2 + 7.3759058058380"-3*R3; M12:= + 1.3296181273333"-2*R2 + 1.3704853933353"-3*R3; M13:= - 2.7333333333333"-2*(R2+R3); M14:= + 5.0786893258335"-3*R2 + 3.5879773408333"-3*R3; M15:= + 1.3147987115999"-1*R2 - 3.5479871159991"-2*R3; M22:= + 1.7453559925000"-3*R2 + 2.5464400750059"-4*R3; M23:= - 3.5879773408336"-3*R2 - 5.0786893258385"-3*R3; M24:= + 6.6666666666667"-4*(R2+R3); M25:= + 1.7259029213333"-2*R2 - 6.5923625466719"-3*R3; M33:= + 7.3759058058380"-3*R2 + 1.0129076086083"-1*R3 + 8.3333333333333"-2*R4; M34:= - 1.3704853933333"-3*R2 - 1.3296181273333"-2*R3; M35:= - 3.5479871159992"-2*R2 + 1.3147987115999"-1*R3; M44:= + 2.5464400750008"-4*R2 + 1.7453559924997"-3*R3; M45:= + 6.5923625466656"-3*R2 - 1.7259029213330"-2*R3; M55:= + .17066666666667"+0*(R2+R3); "COMMENT" ELEMENT LOAD VECTOR; F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL); B1:= + 8.3333333333333"-2*F1 + 2.0543729868749"-1*F2 - 5.5437298687489"-2*F3; B2:= + 2.6967233145832"-2*F2 - 1.0300566479175"-2*F3; B3:= - 5.5437298687489"-2*F2 + 2.0543729868749"-1*F3 + 8.3333333333333"-2*F4; B4:= + 1.0300566479165"-2*F2 - 2.6967233145830"-2*F3; B5:= + 2.6666666666667"-1*(F2+F3); A11:= H2*(H2*M11 + S11) + B11; A12:= H2*(H2*M12 + S12) + B12; A13:= H2*(H2*M13 + S13) + B13; A14:= H2*(H2*M14 + S14) + B14; A15:= H2*(H2*M15 + S15) + B15; A22:= H2*(H2*M22 + S22) + B22; A23:= H2*(H2*M23 + S23) + B23; A24:= H2*(H2*M24 + S24) + B24; A25:= H2*(H2*M25 + S25) + B25; A33:= H2*(H2*M33 + S33) + B33; A34:= H2*(H2*M34 + S34) + B34; A35:= H2*(H2*M35 + S35) + B35; A44:= H2*(H2*M44 + S44) + B44; A45:= H2*(H2*M45 + S45) + B45; A55:= H2*(H2*M55 + S55) + B55; "COMMENT" STATIC CONDENSATION; C1:= A15/A55; C2:= A25/A55; C3:= A35/A55; C4:= A45/A55; B1:= (B1 - C1*B5)*H; B2:= (B2 - C2*B5)*H2; B3:= (B3 - C3*B5)*H; B4:= (B4 - C4*B5)*H2; A11:= (A11 - C1*A15)/H3; A12:= (A12 - C1*A25)/H2; A13:= (A13 - C1*A35)/H3; A14:= (A14 - C1*A45)/H2; A22:= (A22 - C2*A25)/H; A23:= (A23 - C2*A35)/H2; A24:= (A24 - C2*A45)/H; A33:= (A33 - C3*A35)/H3; A34:= (A34 - C3*A45)/H2; A44:= (A44 - C4*A45)/H; "END" "ELSE" "BEGIN" "OWN" "REAL"P5, Q5, R5, F5; "REAL" X2, X3, X4, H, H2, H3, P1, P2, P3, P4, Q1, Q2, Q3, Q4, R1, R2, R3, R4, F1, F2, F3, F4, B11, B12, B13, B14, B15, B16, B22, B23, B24, B25, B26, B33, B34, B35, B36, B44, B45, B46, B55, B56, B66, S11, S12, S13, S14, S15, S16, S22, S23, S24, S25, S26, S33, S34, S35, S36, S44, S45, S46, S55, S56, S66, M11, M12, M13, M14, M15, M16, M22, M23, M24, M25, M26, M33, M34, M35, M36, M44, M45, M46, M55, M56, M66, C15, C16, C25, C26, C35, C36, C45, C46, B5, B6, A15, A16, A25, A26, A35, A36, A45, A46, A55, A56, A66, DET; "IF"L=1"THEN" "BEGIN"P5:= P(XL1); Q5:= Q(XL1); R5:= R(XL1); F5:= F(XL1) "END"; H:= XL - XL1; H2:= H*H; H3:= H*H2; X2:= XL1 + H*.172673164646; X3:= XL1 + H/2; X4:= XL1 + XL - X2; "COMMENT" ELEMENT BENDING MATRIX; P1:= P5; P2:= P(X2); P3:= P(X3); P4:= P(X4); P5:= P(XL); B11:= + 105.8*P1 + 9.8*P5 + 7.3593121303513"-2*P2 + 2.2755555555556"+1*P3 + 7.0565656088553"+0*P4; B12:= + 27.6*P1 + 1.4*P5 - 3.41554824811"-1*P2 + 2.8444444444444"+0*P3 + 1.0113960946522"+0*P4; B13:= - 32.2*(P1 + P5) - 7.2063492063505"-1*(P2 + P4) + 2.2755555555556"+1*P3; B14:= + 4.6*P1 + 8.4*P5 + 1.0328641222944"-1*P2 - 2.8444444444444"+0*P3 - 3.3445562534992"+0*P4; B15:= - (B11 + B13); B16:= - (B12 + B13 + B14 + B15/2); B22:= + 7.2*P1 + 0.2*P5 + 1.5851984028581"+0*P2 + 3.5555555555556"-1*P3 + 1.4496032730059"-1*P4; B23:= - 8.4*P1 - 4.6*P5 + 3.3445562534992"+0*P2 + 2.8444444444444"+0*P3 - 1.0328641222944"-1*P4; B24:= + 1.2*(P1 + P5) - 4.7936507936508"-1*(P2 + P4) - 3.5555555555556"-1*P3; B25:= - (B12 + B23); B26:= - (B22 + B23 + B24 + B25/2); B33:= + 7.0565656088553"+0*P2 + 2.2755555555556"+1*P3 + 7.3593121303513"-2*P4 + 105.8*P5 + 9.8*P1; B34:= - 1.4*P1 - 27.6*P5 - 1.0113960946522"+0*P2 - 2.8444444444444"+0*P3 + 3.4155482481100"-1*P4; B35:= - (B13 + B33); B36:= - (B23 + B33 + B34 + B35/2); B44:= +7.2*P5 + P1/5 + 1.4496032730059"-1*P2 + 3.5555555555556"-1*P3 + 1.5851984028581"+0*P4; B45:= - (B14 + B34); B46:= - (B24 + B34 + B44 + B45/2); B55:= - (B15 + B35); B56:= - (B16 + B36); B66:= - (B26 + B36 + B46 + B56/2); "COMMENT" ELEMENT STIFFNESS MATRIX; Q1:= Q5; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(X4); Q5:= Q(XL); S11:= + 3.0242424037951"+0*Q2 + 3.1539909130065"-2*Q4; S12:= + 1.2575525581744"-1*Q2 + 4.1767169716742"-3*Q4; S13:= - 3.0884353741496"-1*(Q2+Q4); S14:= + 4.0899041243062"-2*Q2 + 1.2842455355577"-2*Q4; S15:= - (S13 + S11); S16:= + 5.9254861177068"-1*Q2 + 6.0512612719116"-2*Q4; S22:= + 5.2292052865422"-3*Q2 + 5.5310763862796"-4*Q4 + Q1/20; S23:= - 1.2842455355577"-2*Q2 - 4.0899041243062"-2*Q4; S24:= + 1.7006802721088"-3*(Q2+Q4); S25:= - (S12 + S23); S26:= + 2.4639593097426"-2*Q2 + 8.0134681270641"-3*Q4; S33:= + 3.1539909130065"-2*Q2 + 3.0242424037951"+0*Q4; S34:= - 4.1767169716742"-3*Q2 - 1.2575525581744"-1*Q4; S35:= - (S13 + S33); S36:= - 6.0512612719116"-2*Q2 - 5.9254861177068"-1*Q4; S44:= + 5.5310763862796"-4*Q2 + 5.2292052865422"-3*Q4 + Q5/20; S45:= - (S14 + S34); S46:= + 8.0134681270641"-3*Q2 + 2.4639593097426"-2*Q4; S55:= - (S15 + S35); S56:= -(S16 + S36); S66:= + 1.1609977324263"-1*(Q2+Q4) + 3.5555555555556"-1*Q3; "COMMENT" ELEMENT MASS MATRIX; R1:= R5; R2:= R(X2); R3:= R(X3); R4:= R(X4); R5:= R(XL); M11:= + 9.7107020727310"-2*R2 + 1.5810259199180"-3*R4 + R1/20; M12:= + 8.2354889460254"-3*R2 + 2.1932154960071"-4*R4; M13:= + 1.2390670553936"-2*(R2+R4); M14:= - 1.7188466249968"-3*R2 - 1.0508326752939"-3*R4; M15:= + 5.3089789712119"-2*R2 + 6.7741558661060"-3*R4; M16:= - 1.7377712856076"-2*R2 + 2.2173630018466"-3*R4; M22:= + 6.9843846173145"-4*R2 + 3.0424512029349"-5*R4; M23:= + 1.0508326752947"-3*R2 + 1.7188466249936"-3*R4; M24:= - 1.4577259475206"-4*(R2+R4); M25:= + 4.5024589679127"-3*R2 + 9.3971790283374"-4*R4; M26:= - 1.4737756452780"-3*R2 + 3.0759488725998"-4*R4; M33:= + 1.5810259199209"-3*R2 + 9.7107020727290"-2*R4 + R5/20; M34:= - 2.1932154960131"-4*R2 - 8.2354889460254"-3*R4; M35:= + 6.7741558661123"-3*R2 + 5.3089789712112"-2*R4; M36:= - 2.2173630018492"-3*R2 + 1.7377712856071"-2*R4; M44:= + 3.0424512029457"-5*R2 + 6.9843846173158"-4*R4; M45:= - 9.3971790283542"-4*R2 - 4.5024589679131"-3*R4; M46:= + 3.0759488726060"-4*R2 - 1.4737756452778"-3*R4; M55:= + 2.9024943310657"-2*(R2+R4) + 3.5555555555556"-1*R3; M56:= + 9.5006428402050"-3*(R4-R2); M66:= + 3.1098153547125"-3*(R2+R4); "COMMENT" ELEMENT LOAD VECTOR; F1:= F5; F2:= F(X2); F3:= F(X3); F4:= F(X4); F5:= F(XL); B1:= + 1.6258748099336"-1*F2 + 2.0745852339969"-2*F4 + F1/20; B2:= + 1.3788780589233"-2*F2 + 2.8778860774335"-3*F4; B3:= + 2.0745852339969"-2*F2 + 1.6258748099336"-1*F4 + F5/20; B4:= - 2.8778860774335"-3*F2 - 1.3788780589233"-2*F4; B5:= + (F2 + F4)/11.25 + 3.5555555555556"-1*F3; B6:= + 2.9095718698132"-2*(F4-F2); A11:= H2*(H2*M11 + S11) + B11; A12:= H2*(H2*M12 + S12) + B12; A13:= H2*(H2*M13 + S13) + B13; A14:= H2*(H2*M14 + S14) + B14; A15:= H2*(H2*M15 + S15) + B15; A16:= H2*(H2*M16 + S16) + B16; A22:= H2*(H2*M22 + S22) + B22; A23:= H2*(H2*M23 + S23) + B23; A24:= H2*(H2*M24 + S24) + B24; A25:= H2*(H2*M25 + S25) + B25; A26:= H2*(H2*M26 + S26) + B26; A33:= H2*(H2*M33 + S33) + B33; A34:= H2*(H2*M34 + S34) + B34; A35:= H2*(H2*M35 + S35) + B35; A36:= H2*(H2*M36 + S36) + B36; A44:= H2*(H2*M44 + S44) + B44; A45:= H2*(H2*M45 + S45) + B45; A46:= H2*(H2*M46 + S46) + B46; A55:= H2*(H2*M55 + S55) + B55; A56:= H2*(H2*M56 + S56) + B56; A66:= H2*(H2*M66 + S66) + B66; "COMMENT" STATIC CONDENSATION; DET:= - A55*A66 + A56*A56; C15:= (A15*A66 - A16*A56)/DET; C16:= (A16*A55 - A15*A56)/DET; C25:= (A25*A66 - A26*A56)/DET; C26:= (A26*A55 - A25*A56)/DET; C35:= (A35*A66 - A36*A56)/DET; C36:= (A36*A55 - A35*A56)/DET; C45:= (A45*A66 - A46*A56)/DET; C46:= (A46*A55 - A45*A56)/DET; A11:= (A11 + C15*A15 + C16*A16)/H3; A12:= (A12 + C15*A25 + C16*A26)/H2; A13:= (A13 + C15*A35 + C16*A36)/H3; A14:= (A14 + C15*A45 + C16*A46)/H2; A22:= (A22 + C25*A25 + C26*A26)/H; A23:= (A23 + C25*A35 + C26*A36)/H2; A24:= (A24 + C25*A45 + C26*A46)/H; A33:= (A33 + C35*A35 + C36*A36)/H3; A34:= (A34 + C35*A45 + C36*A46)/H2; A44:= (A44 + C45*A45 + C46*A46)/H; B1:= (B1 + C15*B5 + C16*B6)*H; B2:= (B2 + C25*B5 + C26*B6)*H2; B3:= (B3 + C35*B5 + C36*B6)*H; B4:= (B4 + C45*B5 + C46*B6)*H2; "END"EL.MATVECEVAL.; L:= 1; W:= V:= 0; N2:= N + N - 2; XL1:= X[0]; XL:= X[1]; YA:= E[1]; ZA:= E[2]; YB:= E[3]; ZB:= E[4]; ELEMENTMATVECEVALUATION; EM[2]:= "-12; R1:= B3 - A13*YA - A23*ZA; D1:= A33; D2:= A44; R2:= B4 - A14*YA - A24*ZA; E1:= A34; "FOR"L:= L + 1"WHILE"L1"THEN"ABS(A[I,I-1])"ELSE" 0; "FOR" J:=I "STEP" 1 "UNTIL" N "DO" "BEGIN" ANI:=ANI+ABS(A[I,J]);BNI:=BNI+ABS(B[I,J]) "END";"IF" ANI>ANORM "THEN" ANORM:=ANI;"IF" BNI>BNORM"THEN" BNORM:=BNI "END";"IF" ANORM=0 "THEN" ANORM:=EPS;"IF"BNORM=0 "THEN" BNORM:=EPS; EPSA:=EPS*ANORM;EPSB:=EPS*BNORM; "FOR" M:=N,M "WHILE" M>=3 "DO" "BEGIN" "FOR" I:=M+1,I-1 "WHILE"("IF" I>1 "THEN"ABS(A[I,I-1])>EPSA "ELSE" "FALSE") "DO" Q:=I-1; "IF" Q>1 "THEN" A[Q,Q-1]:=0; L: "IF" Q>=M-1 "THEN" M:=Q-1 "ELSE" "BEGIN" "IF" ABS(B[Q,Q])<=EPSB "THEN" "BEGIN" B[Q,Q]:=0;Q1:=Q+1; HSH2COL(Q,Q,M,Q,A[Q,Q],A[Q1,Q],A,B);A[Q1,Q]:=0; Q:=Q1;"GOTO" L "END" "ELSE" M1:=M-1;Q1:=Q+1;CONST:=0.75;ITER[M]:=ITER[M]+1; STATIONARY:="IF" ITER[M]=1 "THEN" "TRUE" "ELSE" ABS(A[M,M-1])>=CONST*OLD1"AND"ABS(A[M-1,M-2])>=CONST*OLD2; "IF" ITER[M]>30"AND"STATIONARY "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" ITER[I]:=-1; "GOTO" OUT "END"; "IF" ITER[M]=10"AND"STATIONARY "THEN" "BEGIN" A10:=0;A20:=1;A30:=1.1605 "END" "ELSE" "BEGIN" B11:=B[Q,Q];B22:="IF" ABS(B[Q1,Q1])M "THEN" M "ELSE" K+3; KM1:="IF" K-11"THEN"ABS(A[I,I-1])"ELSE" 0; "FOR" J:=I "STEP" 1 "UNTIL" N "DO" "BEGIN" ANI:=ANI+ABS(A[I,J]);BNI:=BNI+ABS(B[I,J]) "END";"IF" ANI>ANORM "THEN" ANORM:=ANI;"IF" BNI>BNORM"THEN" BNORM:=BNI "END";"IF" ANORM=0 "THEN" ANORM:=EPS;"IF"BNORM=0 "THEN" BNORM:=EPS; EPSA:=EPS*ANORM;EPSB:=EPS*BNORM; "FOR" M:=N,M "WHILE" M>=3 "DO" "BEGIN" "FOR" I:=M+1,I-1 "WHILE"("IF" I>1 "THEN"ABS(A[I,I-1])>EPSA "ELSE" "FALSE") "DO" Q:=I-1; "IF" Q>1 "THEN" A[Q,Q-1]:=0; L: "IF" Q>=M-1 "THEN" M:=Q-1 "ELSE" "BEGIN" "IF" ABS(B[Q,Q])<=EPSB "THEN" "BEGIN" B[Q,Q]:=0;Q1:=Q+1; HSH2COL(Q,Q,N,Q,A[Q,Q],A[Q1,Q],A,B);A[Q1,Q]:=0; Q:=Q1;"GOTO" L "END" "ELSE" M1:=M-1;Q1:=Q+1;CONST:=0.75;ITER[M]:=ITER[M]+1; STATIONARY:="IF" ITER[M]=1 "THEN" "TRUE" "ELSE" ABS(A[M,M-1])>=CONST*OLD1"AND"ABS(A[M-1,M-2])>=CONST*OLD2; "IF" ITER[M]>30"AND"STATIONARY "THEN" "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" ITER[I]:=-1; "GOTO" OUT "END"; "IF" ITER[M]=10"AND"STATIONARY "THEN" "BEGIN" A10:=0;A20:=1;A30:=1.1605 "END" "ELSE" "BEGIN" B11:=B[Q,Q];B22:="IF" ABS(B[Q1,Q1])M "THEN" M "ELSE" K+3; KM1:="IF" K-10 "DO" "IF"("IF" M>1 "THEN" A[M,M-1]=0 "ELSE" "TRUE")"THEN" "BEGIN" ALFR[M]:=A[M,M];BETA[M]:=B[M,M];ALFI[M]:=0;M:=M-1 "END" "ELSE" "BEGIN" L:=M-1;"IF" ABS(B[L,L])<=EPSB "THEN" "BEGIN" B[L,L]:=0;HSH2COL(L,L,N,L,A[L,L],A[M,L],A,B); A[M,L]:=B[M,L]:=0;ALFR[L]:=A[L,L];ALFR[M]:=A[M,M]; BETA[L]:=B[L,L];BETA[M]:=B[M,M];ALFI[M]:=ALFI[L]:=0; "END" "ELSE" "IF" ABS(B[M,M])<=EPSB "THEN" "BEGIN"B[M,M]:=0;HSH2ROW3(1,M,M,N,L,A[M,M],A[M,L],A,B,X); A[M,L]:=B[M,L]:=0;ALFR[L]:=A[L,L];ALFR[M]:=A[M,M]; BETA[L]:=B[L,L];BETA[M]:=B[M,M];ALFI[M]:=ALFI[L]:=0; "END""ELSE" "BEGIN" AN:=ABS(A[L,L])+ABS(A[L,M])+ABS(A[M,L])+ABS(A[M,M]); BN:=ABS(B[L,L])+ABS(B[L,M])+ABS(B[M,M]); A11:=A[L,L]/AN;A12:=A[L,M]/AN;A21:=A[M,L]/AN;A22:=A[M,M]/AN; B11:=B[L,L]/BN;B12:=B[L,M]/BN;B22:=B[M,M]/BN; E:=A11/B11; C:=((A22-E*B22)/B22-(A21*B12)/(B11*B22))/2; D:=C*C+(A21*(A12-E*B12))/(B11*B22); "IF" D>=0 "THEN" "BEGIN"E:=E+("IF"C<0"THEN"C-SQRT(D)"ELSE"C+SQRT(D)); A11:=A11-E*B11;A12:=A12-E*B12;A22:=A22-E*B22; "IF" ABS(A11)+ABS(A12)>=ABS(A21)+ABS(A22) "THEN" HSH2ROW3(1,M,M,N,L,A12,A11,A,B,X)"ELSE" HSH2ROW3(1,M,M,N,L,A22,A21,A,B,X); "IF"AN>=ABS(E)*BN"THEN" HSH2COL(L,L,N,L,B[L,L],B[M,L],A,B) "ELSE" HSH2COL(L,L,N,L,A[L,L],A[M,L],A,B); A[M,L]:=B[M,L]:=0; ALFR[L]:=A[L,L];ALFR[M]:=A[M,M];BETA[L]:=B[L,L]; BETA[M]:=B[M,M];ALFI[M]:=ALFI[L]:=0; "END""ELSE" "BEGIN" ER:=E+C;EI:=SQRT(-D);A11R:=A11-ER*B11;A11I:=EI*B11; A12R:=A12-ER*B12;A12I:=EI*B12;A21R:=A21;A21I:=0; A22R:=A22-ER*B22;A22I:=EI*B22; "IF"ABS(A11R)+ABS(A11I)+ABS(A12R)+ABS(A12I)>= ABS(A21R)+ABS(A22R)+ABS(A22I)"THEN" CHSH2(A12R,A12I,-A11R,-A11I,CZ,SZR,SZI)"ELSE" CHSH2(A22R,A22I,-A21R,-A21I,CZ,SZR,SZI); "IF"AN>=(ABS(ER)+ABS(EI))*BN"THEN" CHSH2(CZ*B11+SZR*B12,SZI*B12,SZR*B22,SZI*B22,CQ,SQR,SQI) "ELSE"CHSH2(CZ*A11+SZR*A12,SZI*A12,CZ*A21+SZR*A22,SZI*A22, CQ,SQR,SQI);SSR:=SQR*SZR+SQI*SZI;SSI:=SQR*SZI-SQI*SZR; TR:=CQ*CZ*A11+CQ*SZR*A12+SQR*CZ*A21+SSR*A22; TI:=CQ*SZI*A12-SQI*CZ*A21+SSI*A22; BDR:=CQ*CZ*B11+CQ*SZR*B12+SSR*B22; BDI:=CQ*SZI*B12+SSI*B22; R:=SQRT(BDR*BDR+BDI*BDI);BETA[L]:=BN*R; ALFR[L]:=AN*(TR*BDR+TI*BDI)/R; ALFI[L]:=AN*(TR*BDI-TI*BDR)/R; TR:=SSR*A11-SQR*CZ*A12-CQ*SZR*A21+CQ*CZ*A22; TI:=-SSI*A11-SQI*CZ*A12+CQ*SZI*A21; BDR:=SSR*B11-SQR*CZ*B12+CQ*CZ*B22; BDI:=-SSI*B11-SQI*CZ*B12; R:=SQRT(BDR*BDR+BDI*BDI);BETA[M]:=BN*R; ALFR[M]:=AN*(TR*BDR+TI*BDI)/R; ALFI[M]:=AN*(TR*BDI-TI*BDR)/R; "END" "END";M:=M-2 "END" "END" QZVAL; "COMMENT" ================== 34602 =================; "PROCEDURE" HSHDECMUL(N,A,B,DWARF);"VALUE"N,DWARF;"INTEGER"N; "REAL" DWARF;"ARRAY" A,B; "BEGIN" "ARRAY" V[1:N];"INTEGER" J,K,K1,N1;"REAL" R,T,C; "REAL" "PROCEDURE" TAMMAT(L,U,I,J,A,B);"CODE" 34014; "PROCEDURE" HSHVECMAT(LR,UR,LC,UC,X,U,A);"CODE" 31070; K:=1;N1:=N+1; "FOR" K1:=2 "STEP" 1 "UNTIL" N1 "DO" "BEGIN" R:=TAMMAT(K1,N,K,K,B,B); "IF" R>DWARF "THEN" "BEGIN" R:="IF" B[K,K]<0 "THEN" -SQRT(R+B[K,K]*B[K,K]) "ELSE" SQRT(R+B[K,K]*B[K,K]);T:=B[K,K]+R;C:=-T/R; B[K,K]:=-R;V[K]:=1; "FOR" J:=K1 "STEP" 1 "UNTIL" N "DO" V[J]:=B[J,K]/T; HSHVECMAT(K,N,K1,N,C,V,B);HSHVECMAT(K,N,1,N,C,V,A) "END";K:=K1 "END" "END" HSHDECMUL; "COMMENT" ================== 34603 =================; "PROCEDURE" HESTGL3(N,A,B,X);"VALUE" N;"INTEGER" N;"ARRAY" A,B,X; "BEGIN" "INTEGER" NM1,K,L,K1,L1; "PROCEDURE" HSH2COL(LA,LB,U,I,A1,A2,A,B);"CODE" 34605; "PROCEDURE" HSH2ROW3(L,UA,UB,UX,J,A1,A2,A,B,X);"CODE" 34607; "IF" N>2 "THEN" "BEGIN" "FOR" K:=2 "STEP" 1 "UNTIL" N "DO" "FOR" L:=1 "STEP" 1 "UNTIL" K-1 "DO" B[K,L]:=0; NM1:=N-1;K:=1; "FOR" K1:= 2 "STEP" 1 "UNTIL" NM1 "DO" "BEGIN" L1:=N; "FOR" L:=N-1 "STEP" -1 "UNTIL" K1 "DO" "BEGIN" HSH2COL(K,L,N,L,A[L,K],A[L1,K],A,B);A[L1,K]:=0; HSH2ROW3(1,N,L1,N,L,B[L1,L1],B[L1,L],A,B,X); B[L1,L]:=0;L1:=L "END";K:=K1 "END" "END" "END" HESTGL3; "COMMENT" ================== 34604 =================; "PROCEDURE" HESTGL2(N,A,B);"VALUE" N;"INTEGER" N;"ARRAY" A,B; "BEGIN" "INTEGER" NM1,K,L,K1,L1; "PROCEDURE" HSH2COL(LA,LB,U,I,A1,A2,A,B);"CODE" 34605; "PROCEDURE" HSH2ROW2(LA,LB,UA,UB,A1,A2,A,B);"CODE" 34608; "IF" N>2 "THEN" "BEGIN" "FOR" K:=2 "STEP" 1 "UNTIL" N "DO" "FOR" L:=1 "STEP" 1 "UNTIL" K-1 "DO" B[K,L]:=0; NM1:=N-1;K:=1; "FOR" K1:= 2 "STEP" 1 "UNTIL" NM1 "DO" "BEGIN" L1:=N; "FOR" L:=N-1 "STEP" -1 "UNTIL" K1 "DO" "BEGIN" HSH2COL(K,L,N,L,A[L,K],A[L1,K],A,B);A[L1,K]:=0; HSH2ROW2(1,1,N,L1,L,B[L1,L1],B[L1,L],A,B); B[L1,L]:=0;L1:=L "END";K:=K1 "END" "END" "END" HESTGL2; "COMMENT" ================== 34605 =================; "PROCEDURE" HSH2COL(LA,LB,U,I,A1,A2,A,B);"VALUE" LA,LB,U,I,A1,A2; "INTEGER" LA,LB,U,I;"REAL" A1,A2;"ARRAY" A,B; "IF"A2^=0 "THEN" "BEGIN" "REAL" R,T,C;"ARRAY" V[I:I+1]; "PROCEDURE" HSHVECMAT(LR,UR,LC,UC,X,U,A);"CODE" 31070; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2) "ELSE" SQRT(A1*A1+A2*A2); T:=A1+R;C:=-T/R;V[I]:=1;V[I+1]:=A2/T; HSHVECMAT(I,I+1,LA,U,C,V,A);HSHVECMAT(I,I+1,LB,U,C,V,B) "END" HSH2COL; "COMMENT" ================== 34606 =================; "PROCEDURE" HSH3COL(LA,LB,U,I,A1,A2,A3,A,B); "VALUE"LA,LB,U,I,A1,A2,A3;"INTEGER"LA,LB,I,U;"REAL"A1,A2,A3;"ARRAY"A,B; "IF" A2^=0 "OR" A3^=0 "THEN" "BEGIN" "REAL" R,T,C;"ARRAY" V[I:I+2]; "PROCEDURE" HSHVECMAT(LR,UR,LC,UC,X,U,A);"CODE" 31070; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2+A3*A3) "ELSE" SQRT(A1*A1+A2*A2+A3*A3); T:=A1+R;C:=-T/R;V[I]:=1;V[I+1]:=A2/T;V[I+2]:=A3/T; HSHVECMAT(I,I+2,LA,U,C,V,A);HSHVECMAT(I,I+2,LB,U,C,V,B) "END" HSH3COL; "COMMENT" ================== 34607 =================; "PROCEDURE" HSH2ROW3(L,UA,UB,UX,J,A1,A2,A,B,X);"VALUE" L,UA,UB,UX, J,A1,A2;"INTEGER" L,UA,UB,UX,J;"REAL" A1,A2;"ARRAY" A,B,X; "IF"A2^=0 "THEN" "BEGIN""REAL" R,T,C;"INTEGER" K;"ARRAY" V[J:J+1]; "PROCEDURE" HSHVECTAM(LR,UR,LC,UC,X,U,A);"CODE" 31073; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2) "ELSE" SQRT(A1*A1+A2*A2); T:=A1+R;C:=-T/R;V[J+1]:=1;V[J]:=A2/T; HSHVECTAM(L,UA,J,J+1,C,V,A);HSHVECTAM(L,UB,J,J+1,C,V,B); HSHVECTAM(1,UX,J,J+1,C,V,X) "END" HSH2ROW3; "COMMENT" ================== 34608 =================; "PROCEDURE" HSH2ROW2(LA,LB,UA,UB,J,A1,A2,A,B);"VALUE"LA,LB,UA,UB, J,A1,A2;"INTEGER" LA,LB,UA,UB,J;"REAL" A1,A2;"ARRAY" A,B; "IF"A2^=0 "THEN" "BEGIN" "REAL" R,T,C;"INTEGER" K;"ARRAY" V[J:J+1]; "PROCEDURE" HSHVECTAM(LR,UR,LC,UC,X,U,A);"CODE" 31073; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2) "ELSE" SQRT(A1*A1+A2*A2); T:=A1+R;C:=-T/R;V[J+1]:=1;V[J]:=A2/T; HSHVECTAM(LA,UA,J,J+1,C,V,A);HSHVECTAM(LB,UB,J,J+1,C,V,B) "END" HSH2ROW2; "COMMENT" ================== 34609 =================; "PROCEDURE" HSH3ROW3(L,U,UX,J,A1,A2,A3,A,B,X); "VALUE"L,U,UX,J,A1,A2,A3;"INTEGER"L,J,U,UX;"REAL"A1,A2,A3;"ARRAY"A,B,X; "IF" A2^=0 "OR" A3^=0 "THEN" "BEGIN" "REAL" R,T,C;"ARRAY" V[J:J+2];"INTEGER" K; "PROCEDURE" HSHVECTAM(LR,UR,LC,UC,X,U,A);"CODE" 31073; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2+A3*A3) "ELSE" SQRT(A1*A1+A2*A2+A3*A3); T:=A1+R;C:=-T/R;V[J+2]:=1;V[J+1]:=A2/T;V[J]:=A3/T; HSHVECTAM(L,U,J,J+2,C,V,A);HSHVECTAM(L,U,J,J+2,C,V,B); HSHVECTAM(L,UX,J,J+2,C,V,X) "END" HSH3ROW3; "COMMENT" ================== 34610 =================; "PROCEDURE" HSH3ROW2(LA,LB,U,J,A1,A2,A3,A,B); "VALUE"LA,LB,U,J,A1,A2,A3;"INTEGER"LA,LB,U,J;"REAL"A1,A2,A3;"ARRAY"A,B; "IF" A2^=0 "OR" A3^=0 "THEN" "BEGIN" "REAL" R,T,C;"ARRAY" V[J:J+2]; "PROCEDURE" HSHVECTAM(LR,UR,LC,UC,X,U,A);"CODE" 31073; R:="IF" A1<0 "THEN" -SQRT(A1*A1+A2*A2+A3*A3) "ELSE" SQRT(A1*A1+A2*A2+A3*A3); T:=A1+R;C:=-T/R;V[J+2]:=1;V[J+1]:=A2/T;V[J]:=A3/T; HSHVECTAM(LA,U,J,J+2,C,V,A);HSHVECTAM(LB,U,J,J+2,C,V,B) "END" HSH3ROW2; "COMMENT" ================== 31070 =================; "PROCEDURE" HSHVECMAT(LR, UR, LC, UC, X, U, A); "VALUE" LR, UR, LC, UC, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" TAMVEC(L, U, I, A, B); "CODE" 34012; "PROCEDURE" ELMCOLVEC(L, U, I, A, B, X); "CODE" 34022; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" ELMCOLVEC(LR, UR, LC, A, U, TAMVEC(LR, UR, LC, A, U) * X) "END"; "COMMENT" ================== 31071 =================; "PROCEDURE" HSHCOLMAT(LR, UR, LC, UC, I, X, U, A); "VALUE" LR, UR, LC, UC, I, X; "INTEGER" LR, UR, LC, UC, I; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" TAMMAT(L, U, I, J, A, B); "CODE" 34014; "PROCEDURE" ELMCOL(L, U, I, J, A, B, X); "CODE" 34023; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" ELMCOL(LR, UR, LC, I, A, U, TAMMAT(LR, UR, LC, I, A, U) * X) "END"; "COMMENT" ================== 31072 =================; "PROCEDURE" HSHROWMAT(LR, UR, LC, UC, I, X, U, A); "VALUE" LR, UR, LC, UC, I, X; "INTEGER" LR, UR, LC, UC, I; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013; "PROCEDURE" ELMCOLROW(L, U, I, J, A, B, X); "CODE" 34029; "FOR" LC:= LC "STEP" 1 "UNTIL" UC "DO" ELMCOLROW(LR, UR, LC, I, A, U, MATMAT(LR, UR, I, LC, U, A) * X) "END"; "COMMENT" ================== 31073 =================; "PROCEDURE" HSHVECTAM(LR, UR, LC, UC, X, U, A); "VALUE" LR, UR, LC, UC, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011; "PROCEDURE" ELMROWVEC(L, U, I, A, B, X); "CODE" 34027; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" ELMROWVEC(LC, UC, LR, A, U, MATVEC(LC, UC, LR, A, U) * X) "END"; "COMMENT" ================== 31074 =================; "PROCEDURE" HSHCOLTAM(LR, UR, LC, UC, I, X, U, A); "VALUE" LR, UR, LC, UC, I, X; "INTEGER" LR, UR, LC, UC, I; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013; "PROCEDURE" ELMROWCOL(L, U, I, J, A, B, X); "CODE" 34028; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" ELMROWCOL(LC, UC, LR, I, A, U, MATMAT(LC, UC, LR, I, A, U) * X) "END"; "COMMENT" ================== 31075 =================; "PROCEDURE" HSHROWTAM(LR, UR, LC, UC, I, X, U, A); "VALUE" LR, UR, LC, UC, I, X; "INTEGER" LR, UR, LC, UC, I; "REAL" X; "ARRAY" U, A; "BEGIN" "REAL" "PROCEDURE" MATTAM(L, U, I, J, A, B); "CODE" 34015; "PROCEDURE" ELMROW(L, U, I, J, A, B, X); "CODE" 34024; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" ELMROW(LC, UC, LR, I, A, U, MATTAM(LC, UC, LR, I, A, U) * X) "END"; "COMMENT" ================== 30006 =================; "REAL" "PROCEDURE" PI; PI:= 3.14159265358979; "COMMENT" ================== 30007 =================; "REAL" "PROCEDURE" E; E:= 2.71828182845905; "COMMENT" ================== 34410 =================; "PROCEDURE" LNGVECVEC(L, U, SHIFT, A, B, C, CC, D, DD); "VALUE" L, U, SHIFT, C, CC; "INTEGER" L,U,SHIFT; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[L], B[L + SHIFT], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGVECVEC; "COMMENT" ================== 34411 =================; "PROCEDURE" LNGMATVEC(L, U, I, A, B, C, CC, D, DD); "VALUE" L, U, I, C, CC; "INTEGER" L, U, I; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[I,L], B[I], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGMATVEC; "COMMENT" ================== 34412 =================; "PROCEDURE" LNGTAMVEC(L, U, I, A, B, C, CC, D, DD); "VALUE" L, U, I, C, CC; "INTEGER" L, U, I; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[L,I], B[I], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGTAMVEC; "COMMENT" ================== 34413 =================; "PROCEDURE" LNGMATMAT(L, U, I, J, A, B, C, CC, D, DD); "VALUE" L, U, I, J, C, CC; "INTEGER" L, U, I, J; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[I,L], B[L,J], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGMATMAT; "COMMENT" ================== 34414 =================; "PROCEDURE" LNGTAMMAT(L, U, I, J, A, B, C, CC, D, DD); "VALUE" L, U, I, J, C, CC; "INTEGER" L, U, I, J; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[L,I], B[L,J], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGTAMMAT; "COMMENT" ================== 34415 =================; "PROCEDURE" LNGMATTAM(L, U, I, J, A, B, C, CC, D, DD); "VALUE" L, U, I, J, C, CC; "INTEGER" L, U, I, J; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[I,L], B[J,L], E, EE); LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGMATTAM; "COMMENT" ================== 34416 =================; "PROCEDURE" LNGSEQVEC(L, U, IL, SHIFT, A, B, C, CC, D, DD); "VALUE" L, U, IL, SHIFT, C, CC; "INTEGER" L, U, IL, SHIFT; "REAL" C, CC, D, DD; "ARRAY" A, B; "BEGIN" "REAL" E, EE; "PROCEDURE" DPMUL(A, B, C, CC); "CODE" 31103; "PROCEDURE" LNGADD(A, AA, B, BB, C, CC); "CODE" 31105; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" DPMUL(A[IL], B[L + SHIFT], E, EE); IL:= IL + L; LNGADD(C, CC, E, EE, C, CC) "END"; D:= C; DD:= CC "END" LNGSEQVEC; "COMMENT" ================== 31507 =================; "PROCEDURE" LNGFULSYMMATVEC(LR, UR, LC, UC, A, B, C); "VALUE" LR, UR, LC, UC, B; "INTEGER" LR, UR, LC, UC; "ARRAY" A, B, C; "BEGIN" "REAL" D, DD; "PROCEDURE" LNGSYMMATVEC(L, U, I, A, B, C, CC, D, DD); "CODE" 34418; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" "BEGIN" LNGSYMMATVEC(LC, UC, LR, A, B, 0, 0, D, DD); C[LR]:= D + DD "END" "END" LNGFULSYMMATVEC; "COMMENT" ================== 31508 =================; "PROCEDURE" LNGRESVEC(LR, UR, LC, UC, A, B, C, X); "VALUE" LR, UR, LC, UC, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" A, B, C; "BEGIN" "REAL" D, DD, E, EE; "PROCEDURE" DPMUL(X, Y, E, EE); "CODE" 31103; "PROCEDURE" LNGMATVEC(L, U, I, A, B, C, CC, D, DD); "CODE" 34411; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" "BEGIN" DPMUL(C[LR], X, E, EE); LNGMATVEC(LC, UC, LR, A, B, E, EE, D, DD); C[LR]:= D + DD "END" "END" LNGRESVEC; "COMMENT" ================== 31509 =================; "PROCEDURE" LNGSYMRESVEC(LR, UR, LC, UC, A, B, C, X); "VALUE" LR, UR, LC, UC, B, X; "INTEGER" LR, UR, LC, UC; "REAL" X; "ARRAY" A, B, C; "BEGIN" "REAL" D, DD, E, EE; "PROCEDURE" DPMUL(X, Y, E, EE); "CODE" 31103; "PROCEDURE" LNGSYMMATVEC(L, U, I, A, B, C, CC, D, DD); "CODE" 34418; "FOR" LR:= LR "STEP" 1 "UNTIL" UR "DO" "BEGIN" DPMUL(C[LR], X, E, EE); LNGSYMMATVEC(LC, UC, LR, A, B, E, EE, D, DD); C[LR]:= D + DD "END" "END" LNGSYMRESVEC; "COMMENT" ================== 34357 =================; "PROCEDURE" ROTCOMCOL(L, U, I, J, AR, AI, CR, CI, S); "VALUE" L, U, I, J, CR, CI, S; "INTEGER" L, U, I, J; "REAL" CR, CI, S; "ARRAY" AR, AI; "BEGIN" "REAL" ARLI, AILI, ARLJ, AILJ; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" ARLI:= AR[L,I]; AILI:= AI[L,I]; ARLJ:= AR[L,J]; AILJ:= AI[L,J]; AR[L,I]:= CR * ARLI + CI * AILI - S * ARLJ; AI[L,I]:= CR * AILI - CI * ARLI - S * AILJ; AR[L,J]:= CR * ARLJ - CI * AILJ + S * ARLI; AI[L,J]:= CR * AILJ + CI * ARLJ + S * AILI; "END" "END" ROTCOMCOL; "COMMENT" ================== 34358 =================; "PROCEDURE" ROTCOMROW(L, U, I, J, AR, AI, CR, CI, S); "VALUE" L, U, I, J, CR, CI, S; "INTEGER" L, U, I, J; "REAL" CR, CI, S; "ARRAY" AR, AI; "BEGIN" "REAL" ARIL, AIIL, ARJL, AIJL; "FOR" L:= L "STEP" 1 "UNTIL" U "DO" "BEGIN" ARIL:= AR[I,L]; AIIL:= AI[I,L]; ARJL:= AR[J,L]; AIJL:= AI[J,L]; AR[I,L]:= CR * ARIL + CI * AIIL + S * ARJL; AI[I,L]:= CR * AIIL - CI * ARIL + S * AIJL; AR[J,L]:= CR * ARJL - CI * AIJL - S * ARIL; AI[J,L]:= CR * AIJL + CI * ARJL - S * AIIL; "END" "END" ROTCOMROW; "COMMENT" ================== 34611 =================; "PROCEDURE"CHSH2(A1R,A1I,A2R,A2I,C,SR,SI); "VALUE"A1R,A1I,A2R,A2I;"REAL"A1R,A1I,A2R,A2I,C,SR,SI; "BEGIN" "REAL" R; "IF" A2R^=0 "OR" A2I^=0 "THEN" "BEGIN" "IF" A1R^=0 "OR" A1I^=0 "THEN" "BEGIN" R:=SQRT(A1R*A1R+A1I*A1I);C:=R; SR:=(A1R*A2R+A1I*A2I)/R;SI:=(A1R*A2I-A1I*A2R)/R; R:=SQRT(C*C+SR*SR+SI*SI);C:=C/R;SR:=SR/R;SI:=SI/R "END" "ELSE" "BEGIN" SI:=C:=0;SR:=1 "END" "END" "ELSE" "BEGIN" C:=1;SR:=SI:=0 "END" "END" CHSH2; "COMMENT" ================== 33314 =================; "PROCEDURE" NONLIN FEM LAG SKEW(X, Y, N, F, FY, FZ, NC, E); "INTEGER" N, NC; "REAL" "PROCEDURE" F, FY, FZ; "ARRAY" X, Y, E; "BEGIN" "INTEGER" L, L1, IT; "REAL" XL1, XL, H, A12, A21, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP, PLM, PRM, PL1, PL3, PL1PL2, PL1PL3, PL2PL2, PL2PL3, PR1PR2, PR1PR3, PR2PR3, PL1QL2, PL1QL3, PL2QL1, PL2QL2, PL2QL3, PL3QL1, PL3QL2, PR1QR2, PR1QR3, PR2QR1, PR2QR2, PR2QR3, PR3QR1, PR3QR2, H2RM, ZL1, ZL, E1, E2, E3, E4, E5, E6, EPS, RHO; "ARRAY" T, SUPER, SUB, CHI, GI[0:N-1], Z[0:N]; "PROCEDURE" DUPVEC(L,U,S,A,B); "CODE" 31030; "PROCEDURE" ELEMENT MAT VEC EVALUATION 1; "BEGIN" "REAL" XM,VL,VR,WL,WR,PR,QM,RM,FM,XL12,XL1XL,XL2,ZM,ZACCM; "IF" NC = 0 "THEN" VL:= VR:= 0.5 "ELSE" "IF" NC = 1 "THEN" "BEGIN" VL:= (XL1*2 + XL)/6; VR:= (XL1 + XL*2)/6 "END" "ELSE" "BEGIN" XL12:= XL1*XL1/12; XL1XL:=XL1*XL/6; XL2:=XL*XL/12; VL:= 3*XL12 + XL1XL + XL2; VR:= 3*XL2 + XL1XL + XL12 "END"; WL:= H*VL; WR:=H*VR; PR:= VR/(VL +VR); XM:= XL1 + H*PR; ZM:= PR*ZL + (1 - PR)*ZL1; ZACCM:= (ZL - ZL1)/H ; QM:= FZ(XM,ZM,ZACCM); RM:= FY(XM, ZM, ZACCM); FM:= F(XM,ZM,ZACCM); TAU1:= WL*RM; TAU2:=WR*RM; B1:= WL*FM - ZACCM*(VL +VR); B2:= WR*FM + ZACCM*(VL + VR); A12:= - (VL + VR)/H + VL*QM + (1 - PR)*PR*RM*(WL + WR); A21:= - (VL + VR)/H - VR*QM + (1 - PR)*PR*RM*(WL + WR); "END" ELEM. M.V. EV.; "PROCEDURE" BOUNDARY CONDITIONS; "IF" L=1 "AND" E2 = 0 "THEN" "BEGIN" TAU1:= 1; B1:= A12:= 0 "END" "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN" "BEGIN" TAU1:= TAU1 - E1/E2 "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN" "BEGIN" TAU2:= 1; B2:= A21:= 0 "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN" "BEGIN" TAU2:= TAU2 + E4/E5 "END" B.C.1; "PROCEDURE" FORWARD BABUSKA; "IF" L=1 "THEN" "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL; GI[0]:= G:= YL:= B1; Y[0]:= YL; SUB[0]:= A21; SUPER[0]:= A12; PP:= A21/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; TL:= TAU2; YL:= B2 "END" "ELSE" "BEGIN" CHI[L1]:= CH:= CH + TAU1; GI[L1]:= G:= G + B1; SUB[L1]:= A21; SUPER[L1]:= A12; PP:= A21/(CH - A12); CH:= TAU2 - CH*PP; G:= B2 - G*PP; T[L1]:= TL + TAU1; TL:= TAU2; Y[L1]:= YL + B1; YL:= B2 "END" FORWARD BABUSKA; "PROCEDURE" BACKWARD BABUSKA; "BEGIN"PP:= YL; Y[N]:= G/CH; G:= PP; CH:= TL; L:= N; "FOR" L:= L - 1 "WHILE" L >= 0 "DO" "BEGIN" PP:= SUPER[L]/(CH - SUB[L]); TL:= T[L]; CH:= TL - CH*PP; YL:= Y[L]; G:= YL - G*PP; Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL) ; "END" "END" BACKWARD BABUSKA; DUPVEC(0,N,0,Z,Y); E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6]; "FOR" IT:= 1, IT + 1 "WHILE" EPS > RHO "DO" "BEGIN" L:= 0;XL:= X[0]; ZL:= Z[0]; "FOR" L:= L + 1 "WHILE" L <= N "DO" "BEGIN" XL1:= XL; L1:= L - 1; XL:= X[L]; H:= XL - XL1; ZL1:= ZL; ZL:= Z[L]; ELEMENT MAT VEC EVALUATION 1; "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS; FORWARD BABUSKA "END"; BACKWARD BABUSKA; EPS:= 0; RHO:= 1; "FOR" L:= 0 "STEP" 1 "UNTIL" N "DO" "BEGIN" RHO:= RHO + ABS(Z[L]); EPS:= EPS + ABS(Y[L]); Z[L]:= Z[L] - Y[L] "END"; RHO:= "-14*RHO "END"; DUPVEC(0,N,0,Y,Z) "END" NONLIN FEM LAG SKEW;