================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;         
================== 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);"COMMENT"        
        
         "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;
================== 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;       
================== 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;       
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;       
================== 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;    
================== 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;   
================== 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;    
================== 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;
================== 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;
================== 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;       
================== 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;
================== 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;
================== 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;       
================== 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;       
================== 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;    
================== 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;
================== 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;    
================== 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; 
================== 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;    
================== 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; 
================== 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;    
================== 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;    
================== 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;
================== 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;
================== 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;
================== 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;       
================== 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;
================== 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";   
                                                               "COMMENT"      
1SECTION 3.1.2.1.1.1.1.3      (JUNE 1974)                         PAGE 6      
                                                                  ; 
        
        
         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;       
================== 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;   
================== 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;
================== 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;  
================== 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;
================== 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;
================== 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;       
================== 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;       
================== 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;    
================== 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;       
================== 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;    
================== 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;     
================== 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;     
================== 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;  
================== 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;
================== 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;
================== 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;
================== 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;       
                                                               "COMMENT"      
1SECTION:3.2.1.1.2            (JUNE 1974)                         PAGE 5      
                                                                  ; 
        
        
         "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;       
================== 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;       
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;       
================== 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;      
================== 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;      
================== 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"
        
1SECTION:3.2.1.2.2.1          (JUNE 1974)                         PAGE 9      
        
        
        
             "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;       
================== 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;       
================== 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";     
                                                               "COMMENT"      
1SECTION:3.2.1.2.2.1          (JUNE 1974)                        PAGE 12      
                                                                 ;  
        
        
                 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;    
================== 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;       
================== 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;       
================== 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; 
================== 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; 
================== 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; 
================== 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;       
================== 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
1SECTION 3.3.1.1.1            (JULY 1974)                        PAGE 11      
                                                                 ;  
        
        
             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;       
================== 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;       
================== 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;      
================== 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;         
================== 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;      
================== 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;         
================== 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;      
================== 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;
================== 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;      
================== 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;     
         "COMMENT"
1SECTION 3.3.1.2.1            (JULY 1974)                        PAGE 13      
                                                                 ;  
        
        
         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;       
================== 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;       
================== 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"
1SECTION 3.3.1.2.1            (JULY 1974)                        PAGE 16      
        
        
        
             "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;
================== 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;    
                                                               "COMMENT"      
1SECTION 3.3.1.2.1            (JULY 1974)                        PAGE 18      
      @ @     @   @                                              ;  
        
        
             "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;       
================== 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"    
1SECTION 3.3.1.2.1            (JULY 1974)                        PAGE 20      
                                                                 ;  
        
        
         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;       
================== 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;       
================== 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;         
================== 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;         
================== 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;       
================== 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;         
================== 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;       
================== 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;
================== 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;       
================== 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;
================== 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;"COMMENT"         
1SECTION 3.3.2.2.1            (JULY 1974)                         PAGE 9      
                                                                  ; 
        
        
                 "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;       
================== 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];"COMMENT"        
1SECTION 3.3.2.2.1            (JULY 1974)                        PAGE 10      
                                                                 ;  
        
        
         "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"
1SECTION 3.3.2.2.1            (JULY 1974)                        PAGE 11      
        
        
        
             "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" "COMMENT"      
1SECTION 3.3.2.2.1            (JULY 1974)                        PAGE 12      
                                                                 ;  
        
        
                 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;
================== 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;       
================== 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;
================== 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"
1SECTION : 3.5.1.1            (JULY 1974)                         PAGE 5      
                                                                  ; 
        
        
         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;        
================== 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;"COMMENT" 
1SECTION : 3.5.1.1            (JULY 1974)                         PAGE 6      
                                                                  ; 
        
        
        
     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;     
================== 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; 
================== 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;        
================== 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;    
================== 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;     
================== 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;
1SECTION : 4.1                (JULY 1974)                         PAGE 6      
                                                                  ; 
        
        
        
              "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;    
================== 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;
================== 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;
================== 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; 
================== 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; 
================== 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;
================== 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;
================== 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;                          "COMMENT"
1SECTION : 5.2.1.1.1.1.A      (AUGUST 1974)                       PAGE 4
                                                                  ;
 
 
       "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;
================== 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"; 
                                                               "COMMENT"      
1SECTION : 5.2.1.1.1.1.B 
                                                                  ; 
        
        
    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;    
================== 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;                                           "COMMENT"      
1SECTION : 5.2.1.1.1.1.C      (AUGUST 1974)                       PAGE 5      
                                                                  ; 
        
        
       "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";                                                  "COMMENT"      
1SECTION : 5.2.1.1.1.1.C      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
    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;   
================== 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);                                                "COMMENT"      
1SECTION : 5.2.1.1.1.1.D      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
          "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";                                                  "COMMENT"      
1SECTION : 5.2.1.1.1.1.D      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
       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;  
================== 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;                                          "COMMENT"
 
1SECTION : 5.2.1.1.1.1.F      (AUGUST 1974)                       PAGE 7
                                                                  ;
 
 
         "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;                              "COMMENT"
 
1SECTION : 5.2.1.1.1.1.F      (DECEMBER 1979)                     PAGE 8
                                                                  ;
 
 
         "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;                                            "COMMENT"
 
1SECTION : 5.2.1.1.1.1.F      (AUGUST 1974)                       PAGE 9
                                                                  ;
 
 
         "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"
 
1SECTION : 5.2.1.1.1.1.F      (DECEMBER 1979)                    PAGE 10
                                                                  ;
 
 
         "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"                                               "COMMENT"
1SECTION : 5.2.1.1.1.1.F      (AUGUST 1974)                      PAGE 11
                                                                  ;
 
 
                 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;
================== 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"                                               "COMMENT"      
1SECTION : 5.2.1.1.1.1.G      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
                 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;   
================== 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;
                                                               "COMMENT"
1SECTION : 5.2.1.1.1.1.H      (DECEMBER 1979)                     PAGE 7
                                                                  ;
 
 
         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;
 
1SECTION : 5.2.1.1.1.1.H     (DECEMBER 1975)                     PAGE 8
                                                                  ;
 
 
     "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;
 
1SECTION : 5.2.1.1.1.1.H     (DECEMBER 1975)                     PAGE 9
                                                                  ;
 
 
     "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;
================== 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;                 "COMMENT"      
        
1SECTION : 5.2.1.1.1.1.I      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
     "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" J<L "THEN" BETAC[J] "ELSE" 0))*  
                    PT[J]/(I-J)-C/B;  
                 BETA[I]:=C/B/FAC[L+R-I]/FAC[I-R-1]+      
                          ("IF" I<L "THEN" BB*BETAC[I] "ELSE" 0);   
                 BB:=BB*B   
             "END"
         "END"    
     "END" FORM BETA;       
        
     "PROCEDURE" SOLUTION OF COMPLEX EQUATIONS; 
     "BEGIN" "INTEGER" I,J,C1,C3;     
         "REAL" C2,E,B1,ZI,COSIPHI,SINIPHI,COSPHIL;       
         "REAL" "ARRAY" D[1:L];                                "COMMENT"      
        
1SECTION : 5.2.1.1.1.1.I      (AUGUST 1974)                       PAGE 8      
                                                                  ; 
        
        
         "PROCEDURE" ELEMENTS OF MATRIX;
         "BEGIN" PHIL:=PHI0;
             COSPHI:=COS(PHIL); SINPHI:=SIN(PHIL);
             COSIPHI:=1; SINIPHI:=0;  
             "FOR" I:=0 "STEP" 1 "UNTIL" L-1 "DO" 
             "BEGIN" C1:=R+1+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:=C1*C2; 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" RIGHTHANDSIDE;   
         "BEGIN" E:=EXP(B*COSPHI);    
             B1:=B*SINPHI-(R+1)*PHIL; 
             COSIPHI:=E*COS(B1); SINIPHI:=E*SIN(B1);      
             B1:=1/B; ZI:=B1**R;      
             "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"; 
             COSIPHI:=ZI:=1; SINIPHI:=0;
             "FOR" I:=R "STEP" -1 "UNTIL" 0 "DO"
             "BEGIN" C1:=I; C2:=BETA[I];
                 C3:="IF" 2*I>L-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;                                         "COMMENT"      
        
1SECTION : 5.2.1.1.1.1.I      (AUGUST 1974)                       PAGE 9      
                                                                  ; 
        
        
     "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" J<L "THEN" B "ELSE" 1); 
                     LABDA[J]:=C-.25  
                 "END"      
             "END"
         "END" "ELSE"       
         "BEGIN" THETA0:=0; THETANM1:=1;
             "IF" B<1 "THEN"
             "BEGIN" "FOR" J:=N-1 "STEP" -1 "UNTIL" 1 "DO"
                 MU[J]:=LABDA[J]:=1/(N-J+1)     
             "END" "ELSE"   
             "BEGIN" LABDA[N-1]:=MU[N-1]:=BETA[2];
                 "FOR" J:=N-2 "STEP" -1 "UNTIL" 1 "DO"    
                 MU[J]:=LABDA[J]:=BETA[N-J+1]/BETA[N-J]/  
                        ("IF" J<L "THEN" B "ELSE" 1)      
             "END"
         "END"    
     "END" COEFFICIENT;                                        "COMMENT"      
        
1SECTION : 5.2.1.1.1.1.I      (AUGUST 1974)                      PAGE 10      
                                                                 ;  
        
        
     "PROCEDURE" STEPSIZE;  
     "BEGIN" "REAL" D,HSTAB,HSTABINT; 
         H:=STEP; 
         D:=ABS(SIGMA*SIN(PHI));      
         COMPLEX:=L//2*2=L "AND" 2*D>DIAMETER;  
         "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" H<T*EPS  "THEN" "GOTO" ENDOFEFRK; 
         CHANGE:=B0=-1 "OR" ((B-B0)*(B-B0)+B*B0*(PHI-PHI0)*(PHI-PHI0)>D)      
     "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<N-1 "THEN" "GOTO" NEXTTERM;     
         T:=T+H   
     "END" DIFFERENCE SCHEME; 
        
     N:=R+L; FIRST:="TRUE"; B0:=-1; BETAR:=BETA[R]**(1/R);
     LAST:="FALSE"; EPS:=2**(-48); PI:=PHI0:=PHIL:=4*ARCTAN(1);     
 NEXTLEVEL:       
     STEPSIZE;    
     "IF" CHANGE "THEN" COEFFICIENT;  
     K:=K+1;      
     DIFFERENCE SCHEME;     
     OUTPUT;      
     "IF" "NOT" LAST "THEN" "GOTO" NEXTLEVEL;   
 ENDOFEFRK:       
 "END" EXPONENTIALLY FITTED RUNGE KUTTA;
================== 33160 =================
     "PROCEDURE" EFSIRK(X, XE, M, Y, DELTA, DERIVATIVE, JACOBIAN, J,
                        N, AETA, RETA, HMIN, HMAX, LINEAR, OUTPUT); 
     "VALUE" M; "INTEGER" M, N;       
     "REAL" X, XE, DELTA, AETA, RETA, HMIN, HMAX;         
     "PROCEDURE" DERIVATIVE, JACOBIAN, OUTPUT;  
     "BOOLEAN" LINEAR;      
     "ARRAY" Y, J;
        
     "BEGIN" "INTEGER" K, L;
         "REAL" STEP, H, MU0, MU1, MU2, THETA0, THETA1, NU1, NU2,   
         NU3, YK, FK, C1, C2, D;      
         "ARRAY" F, K0, LABDA[1 : M], J1[1 : M,1 : M], AUX[1 : 7];  
         "INTEGER" "ARRAY" RI, CI[1 : M];       
         "BOOLEAN" LIN;     
         "REAL" "PROCEDURE" VECVEC(L, U, SHIFT, A, B); "CODE" 34010;
         "REAL" "PROCEDURE" MATMAT(L, U, I, J, A, B); "CODE" 34013; 
         "REAL" "PROCEDURE" MATVEC(L, U, I, A, B); "CODE" 34011;    
         "PROCEDURE" GSSELM(A, N, AUX, RI, CI); "CODE" 34231;       
         "PROCEDURE" SOLELM(A, N, RI, CI, B); "CODE" 34061;         
        
         "REAL" "PROCEDURE" STEPSIZE; 
         "BEGIN" "REAL" DISCR, ETA, S;
             "IF" LINEAR "THEN" S:= H:= HMAX "ELSE"       
             "IF" N = 1 "OR" HMIN = HMAX "THEN" S:= H:= HMIN "ELSE" 
             "BEGIN" ETA:= AETA + RETA * SQRT(VECVEC(1, M, 0, Y, Y));         
                 C1:= NU3 * STEP; "FOR" K:= 1 "STEP" 1 "UNTIL" M "DO"         
                 LABDA[K]:= LABDA[K] + C1 * F[K] - Y[K];  
                 DISCR:= SQRT(VECVEC(1, M, 0, LABDA, LABDA));       
                 S:= H:= (ETA / (0.75 * (ETA + DISCR)) + 0.33) * H; 
                 "IF" H < HMIN "THEN" S:= H:= HMIN "ELSE" 
                 "IF" H > 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";                                        "COMMENT"      
1SECTION : 5.2.1.1.1.2.A      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
                 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;
================== 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;                                           "COMMENT"      
        
1SECTION : 5.2.1.1.1.2.B      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
     "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";                                            "COMMENT"      
1SECTION : 5.2.1.1.1.2.B      (AUGUST 1974)                       PAGE 8      
                                                                  ; 
        
        
             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";                                                "COMMENT"      
1SECTION : 5.2.1.1.1.2.B      (AUGUST 1974)                       PAGE 9      
                                                                  ; 
        
        
         "IF" H<HMIN "THEN" H:=HMIN;  
         "IF" H>HMAX "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<M "THEN"   
         "BEGIN" D2[M]:=1; K0[M]:=Y[M]+2*H/3; Y[M]:=Y[M]+.25*H "END";         
         "FOR" K:=1 "STEP" 1 "UNTIL" M1 "DO"    
         "BEGIN" K0[K]:=Y[K]+2*H/3*D[K];        
             Y[K]:=Y[K]+.25*H*D[K];   
             D1[K]:=H*MATVEC(1,M,K,J,D);        
             D2[K]:=D1[K]+D[K]        
         "END";   
         "FOR" I:=0 "STEP" 1 "UNTIL" L "DO"     
         "BEGIN" BETAI:=4*BETA[I]/3; BETHAI:=BETHA[I];    
             "FOR" K:=1 "STEP" 1 "UNTIL" M1 "DO" D[K]:=H*D1[K];     
             "FOR" K:=1 "STEP" 1 "UNTIL" M1 "DO"
             "BEGIN" K0[K]:=K0[K]+BETAI*D[K];   
                 D1[K]:=MATVEC(1,M1,K,J,D);     
                 D2[K]:=D2[K]+BETHAI*D1[K]      
             "END"
         "END";   
         DERIVATIVE(K0);    
         "FOR" K:=1 "STEP" 1 "UNTIL" M "DO" Y[K]:=Y[K]+.75*H*K0[K]  
     "END" DIFF SCHEME;     
        
     B0:=PHI0:=-1; PI:=4*ARCTAN(1);   
     BETAC[L]:=BETAC[L+1]:=BETAC[L+2]:=BETAC[L+3]:=0;     
     BETA[0]:=1/6; BETHA[0]:=.5;      
     FAC:=1; "FOR" I:=2 "STEP" 1 "UNTIL" L-1 "DO" FAC:=I*FAC;       
     M1:= "IF" AUT "THEN" M "ELSE" M-1;         
     K:=0; LAST:="FALSE";   
  NEXT LEVEL:     
     "FOR" I:=1 "STEP" 1 "UNTIL" M "DO" D[I]:=Y[I];       
     DERIVATIVE(D);         
     "IF" "NOT" LINEAR "OR" K=0 "THEN" JACOBIAN(J,Y);     
     STEPSIZE;    
     "IF" CHANGE "THEN" COEFFICIENT;  
     OUTPUT;      
     DIFFERENCE SCHEME;     
     K:=K+1;      
     X:=X+H;      
     "IF" "NOT" LAST "THEN" "GOTO" NEXT LEVEL;  
 END OF EFERK: OUTPUT;      
 "END" EFERK;     
================== 33131 =================
 "PROCEDURE" LINIGER2(X,XE,M,Y,SIGMA1,SIGMA2,F,EVALUATE,J,
                JACOBIAN,K,ITMAX,STEP,AETA,RETA,OUTPUT);  
 "INTEGER" M,K,ITMAX;       
 "REAL" X,XE,SIGMA1,SIGMA2,STEP,AETA,RETA;      
 "ARRAY" Y,J;     
 "BOOLEAN" "PROCEDURE" EVALUATE;      
 "REAL" "PROCEDURE" F;      
 "PROCEDURE" JACOBIAN,OUTPUT;         
        
 "BEGIN" "INTEGER" I;       
     "REAL" H,HL,B1,B2,P,Q,C0,C1,C2,C3,C4;      
     "BOOLEAN" LAST;        
     "INTEGER" "ARRAY" PI[1:M];       
     "REAL" "ARRAY" DY,YL,FL[1:M],A[1:M,1:M],AUX[1:3];    
     "REAL" "PROCEDURE" VECVEC(L,U,SHIFT,A,B); "CODE" 34010;        
     "REAL" "PROCEDURE" MATVEC(L,U,I,A,B); "CODE" 34011;  
     "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B); "CODE" 34013;
     "PROCEDURE" DEC(A,N,AUX,P); "CODE" 34300;  
     "PROCEDURE" SOL(A,N,P,B); "CODE" 34051;    
        
     "PROCEDURE" STEPSIZE;  
     "BEGIN" H:=STEP;       
         "IF" 1.1*H>=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)<B1*B1*"-6 "THEN" "GOTO" DOUBLEFIT;         
        
         R1:=R(B1)*B1; R2:=R(B2)*B2;  
         D:=B2*R1-B1*R2;    
         P:=2*(R2-R1)/D;    
         Q:=2*(B2-B1)/D;    
         "GOTO" OUT;                                           "COMMENT"      
1SECTION : 5.2.1.1.1.2.D      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
 THIRDORDER: Q:=1/3;        
         P:=R(B1)/3-2/B1;   
         "GOTO" OUT;        
 DOUBLEFIT: B1:=.5*(B1+B2); 
         R1:=R(B1);         
         "IF" B1>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" ETA<B1*B1*"-6 "THEN"    
         "BEGIN" B1:=B2:=ZETA; "GOTO" DOUBLEFIT "END";    
         "IF" ZETA>40 "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;                                            "COMMENT"      
1SECTION : 5.2.1.1.1.2.D      (AUGUST 1974)                       PAGE 8      
                                                                  ; 
        
        
     "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" ITNUM<ITMAX "THEN"      
         "BEGIN" ETA:=SQRT(VECVEC(1,M,0,Y,Y))*RETA+AETA;  
             DISCR:=SQRT(VECVEC(1,M,0,DY,DY));  
             "IF" ETA<DISCR "THEN" "GOTO" NEXT  
         "END"    
     "END" NEWTON;
        
     LAST:="FALSE"; K:=0; HL:=0;      
 NEXT LEVEL:      
     K:=K+1;      
     STEPSIZE;    
     NEWTON ITERATION;      
     HL:=H;       
     OUTPUT;      
     "IF" "NOT" LAST "THEN" "GOTO" NEXT LEVEL   
 "END" LINIGER2;  
================== 33040 =================
 "PROCEDURE" MODIFIED TAYLOR(T,TE,M0,M,U,SIGMA,TAUMIN,I,DERIVATIVE,K,         
                   DATA,ALFA,NORM,AETA,RETA,ETA,RHO,OUT); 
 "INTEGER" M0,M,I,K,NORM;   
 "REAL" T,TE,SIGMA,TAUMIN,ALFA,AETA,RETA,ETA,RHO;         
 "ARRAY" U,DATA;  
 "PROCEDURE" DERIVATIVE,OUT;
        
 "BEGIN" I:=0;    
     "BEGIN" "INTEGER" N,P,Q;         
         "OWN" "REAL" EC0,EC1,EC2,TAU0,TAU1,TAU2,TAUS,T2; 
         "REAL" T0,TAU,TAUI,TAUEC,ECL,BETAN,GAMMA;        
         "REAL" "ARRAY" C[M0:M],BETA,BETHA[1:DATA[-2]];   
         "BOOLEAN" START,STEP1,LAST;  
         "REAL" "PROCEDURE" VECVEC(L,U,SHIFT,A,B); "CODE" 34010;    
        
         "PROCEDURE" COEFFICIENT;     
         "BEGIN" "INTEGER" J;"REAL" IFAC;       
             IFAC:=1; GAMMA:=.5; N:=DATA[-2]; P:=DATA[-1];
             BETAN:=DATA[0]; Q:= "IF" P<N "THEN" P+1 "ELSE" N;      
             "FOR" J:=1 "STEP" 1 "UNTIL" N "DO" 
             "BEGIN" BETA[J]:=DATA[J]; IFAC:=IFAC/J;      
                 BETHA[J]:=IFAC-BETA[J]         
             "END";         
             "IF" P=N "THEN" BETHA[N]:=IFAC     
         "END";                                                "COMMENT"      
        
1SECTION : 5.2.1.1.1.3.A      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
        
         "REAL" "PROCEDURE" NORMFUNCTION(NORM,W);         
         "INTEGER" NORM; "ARRAY" W;   
         "BEGIN" "INTEGER" J; "REAL" S,X;       
             S:=0;
             "IF" NORM=1 "THEN"       
             "BEGIN" "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO"  
                 "BEGIN"  X:=ABS(W[J]); "IF" X>S "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"  
1SECTION : 5.2.1.1.1.3.A      (AUGUST 1974)                       PAGE 7      
        
        
        
                 "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" TAUACC<GAMMA*TAUS "THEN" TAUACC:=GAMMA*TAUS;        
                 "END"      
             "END" "ELSE" TAUACC:=TE-T;         
             "IF" TAUACC<TAUMIN "THEN" TAUACC:=TAUMIN;    
             TAUSTAB:=BETAN/SIGMA;    
             "IF" TAUSTAB<"-12 * (T-T0) "THEN"  
             "BEGIN" OUT;"GOTO" END OF MODIFIED TAYLOR "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";   
        
         "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" I<N "THEN" "GOTO" NEXT TERM;  
             T2:=T; "IF" LAST "THEN"  
             "BEGIN" LAST:= "FALSE"; T:= TE "END"         
             "ELSE" T:= T + TAU       
         "END";   
        
         START:= K=0; T0:=T;
         COEFFICIENT; LAST:= "FALSE"; 
       NEXT LEVEL:
         STEPSIZE; K:=K+1; I:=0; DIFFERENCE SCHEME; OUT;  
         "IF" T ^= TE "THEN" "GOTO" NEXT LEVEL  
     "END";       
     END OF MODIFIED TAYLOR:
 "END" MODIFIED TAYLOR;     
================== 33050 =================
 "PROCEDURE" EXPONENTIALLY FITTED TAYLOR(T,TE,M0,M,U,SIGMA,PHI,DIAMETER,      
         DERIVATIVE,I,K,ALFA,NORM,AETA,RETA,ETA,RHO,HMIN,HSTART,OUTPUT);      
 "INTEGER" M0,M,I,K,NORM;   
 "REAL" T,TE,SIGMA,PHI,DIAMETER,ALFA,AETA,RETA,ETA,RHO,HMIN,HSTART; 
 "ARRAY" U;       
 "PROCEDURE" DERIVATIVE,OUTPUT;       
 "BEGIN" "INTEGER" KL;      
     "REAL" Q,EC0,EC1,EC2,H,HI,H0,H1,H2,BETAN,T2,SIGMAL,PHIL;       
     "REAL" "ARRAY" C,RO[M0:M],BETA,BETHA[1:3]; 
     "BOOLEAN" LAST,START;  
     "PROCEDURE" INIVEC(L,U,A,X); "CODE" 31010; 
     "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;   
     "BOOLEAN" "PROCEDURE" ZEROIN(X, Y, FX, EPS); "CODE" 34150;     
        
     "PROCEDURE" COEFFICIENT;         
     "BEGIN" "REAL" B,B1,B2,BB,E,BETA2,BETA3;   
         B:=H*SIGMAL; B1:=B*COS(PHIL); BB:=B*B; 
         "IF" ABS(B)<"-3 "THEN"       
         "BEGIN" BETA2:=.5-BB/24;     
             BETA3:=1/6+B1/12;        
             BETHA[3]:=.5+B1/3        
         "END" "ELSE"       
         "IF" B1<-40 "THEN" 
         "BEGIN" BETA2:=(-2*B1-4*B1*B1/BB+1)/BB;
             BETA3:=(1+2*B1/BB)/BB;   
             BETHA[3]:=1/BB 
         "END" "ELSE"       
         "BEGIN" E:=EXP(B1)/BB; B2:=B*SIN(PHIL);
             BETA2:=(-2*B1-4*B1*B1/BB+1)/BB;    
             BETA3:=(1+2*B1/BB)/BB;   
             "IF" ABS(B2/B)<"-5 "THEN"
             "BEGIN" BETA2:=BETA2-E*(B1-3);     
                 BETA3:=BETA3+E*(B1-2)/B1;      
                 BETHA[3]:=1/BB+E*(B1-1)        
             "END" "ELSE"   
             "BEGIN" BETA2:=BETA2-E*SIN(B2-3*PHIL)/B2*B;  
                 BETA3:=BETA3+E*SIN(B2-2*PHIL)/B2;        
                 BETHA[3]:=1/BB+E*SIN(B2-PHIL)/B2*B;      
             "END"
         "END";   
         BETA[1]:=BETHA[1]:=1;        
         BETA[2]:=BETA2; BETA[3]:=BETA3;        
         BETHA[2]:=1-BB*BETA3; B:=ABS(B);       
         Q:="IF" B<1.5 "THEN" 4-2*B/3 "ELSE" "IF" B<6 "THEN" (30-2*B)/9       
         "ELSE" 2;
     "END";                                                    "COMMENT"      
        
1SECTION : 5.2.1.1.1.3.B      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
     "REAL" "PROCEDURE" NORMFUNCTION(NORM,W);   
     "INTEGER" NORM; "ARRAY" W;       
     "BEGIN" "INTEGER" J; "REAL" S,X; 
         S:=0;    
         "IF" NORM=1 "THEN" 
         "BEGIN" "FOR" J:=M0 "STEP" 1 "UNTIL" M "DO"      
             "BEGIN" X:=ABS(W[J]); "IF" X>S "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" ETA<RHO "THEN" (ETA/RHO)**(1/Q) "ELSE" ALFA);        
             "IF" A>0 "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" HACC<HMIN "THEN" HACC:=HMIN; H:=HACC;            "COMMENT"      
1SECTION : 5.2.1.1.1.3.B      (AUGUST 1974)                       PAGE 8      
                                                                  ; 
        
        
         "IF" H*SIGMAL>1 "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" H<HCR "THEN" HCR*(1-"-7) "ELSE" HCR*(1+"-7);       
         "IF" T+H>TE "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;    
================== 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;      "COMMENT"
1SECTION : 5.2.1.1.2.1.A      (AUGUST 1974)                       PAGE 5
                                                                  ;
 
 
       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;
================== 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";                                                  "COMMENT"      
1SECTION : 5.2.1.1.2.1.B      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
       "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";                                                  "COMMENT"      
1SECTION : 5.2.1.1.2.1.B      (AUGUST 1974)                       PAGE 7      
                                                                  ; 
        
        
       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;   
================== 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";                                  "COMMENT"      
1SECTION : 5.2.1.1.2.1.C      (AUGUST 1974)                       PAGE 5      
                                                                  ; 
        
        
    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;    
================== 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";                                                  "COMMENT"      
1SECTION : 5.2.1.1.2.1.D      (AUGUST 1974)                       PAGE 5      
                                                                  ; 
        
        
       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;                                  "COMMENT"      
1SECTION : 5.2.1.1.2.1.D      (AUGUST 1974)                       PAGE 6      
                                                                  ; 
        
        
       "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;   
================== 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;
================== 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;
================== 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)));
================== 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;
                                                               "COMMENT"
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 8
                                                                  ;
 
 
        "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;
================== 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;
                                                               "COMMENT"
1SECTION : 6.5.1              (SEPTEMBER 1974)                   PAGE 10
                                                                 ;
 
 
             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;
================== 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<WO1 "DO"
             "BEGIN"
                 WE1:= WE; WO1:=WO;
                 R:= N+K; S:= R + X + K;
                 UE:= 1/(1-K*(R-1)*UE/((S-2)*S));
                 UO:= 1/(1-K*  R  *UO/( S * S-1));
                 VE:= VE * (UE-1);
                 VO:= VO * (UO-1);
                 WE:= WE + VE;
                 WO:= WO + VO;
                 W:= (WE + WO)/2;
                 K1:= K1 + 1
             "END"
         "END";
         AN:=W;
         "IF" N<=N2 & N>=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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;    
================== 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);        
                                                               "COMMENT"      
        
1SECTION : 5.1.3.1.3 
                                                                 ;  
        
        
            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" LAMBDA<LAMBDAMIN "THEN" LAMBDA:= LAMBDAMIN      
                     "END"; 
                     "IF" P<PW "THEN" "GOTO" L "ELSE"     
                     "BEGIN" ERR:= 4; 
                             "GOTO" EXIT        
                     "END"; 
                 "END";     
        
                 DUPVEC(1,N,0,PAR,PARPRES);     
                 FPAR:=FPARPRES       
           "END" ITERATION; 
        
      EXIT:       
           "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"   
           MULCOL(1,N,I,I,JAC,V,1/(VAL[I]+IN[0]));        
           "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"   
           "FOR" J:=1 "STEP" 1 "UNTIL" I "DO"   
           V[I,J]:= V[J,I]:= MATTAM(1,N,I,J,JAC,JAC);     
        
           LAMBDA:= LAMBDAMIN:= VAL[1];         
           "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO"  
           "IF" VAL[I]>LAMBDA    "THEN" LAMBDA   := VAL[I] "ELSE"   
           "IF" VAL[I]<LAMBDAMIN "THEN" LAMBDAMIN:= VAL[I];         
        
           OUT[7]:=(LAMBDA/(LAMBDAMIN+IN[0]))**2;         
           OUT[2]:=SQRT(FPAR);        
           OUT[6]:=SQRT(RES+FPAR)-OUT[2];       
      ESCAPE:     
           OUT[4]:=FE;      
           OUT[5]:=IT-1;    
           OUT[1]:=ERR      
      "END" MARQUARDT;      
================== 33135 =================
 "PROCEDURE" IMPEX (N, T0, TEND, Y0, DERIV, AVAILABLE, H0, HMAX,    
                   PRESCH, EPS, WEIGHTS, UPDATE, FAIL, CONTROL);    
 "VALUE" N;       
 "INTEGER" N;     
 "REAL" T0,TEND,H0,HMAX,EPS;
 "BOOLEAN" PRESCH,FAIL;     
 "ARRAY" Y0,WEIGHTS;        
 "BOOLEAN" "PROCEDURE" AVAILABLE;     
 "PROCEDURE" DERIV,UPDATE,CONTROL;    
 "BEGIN" "INTEGER" I,K,ECI; 
     "REAL" T,T1,T2,T3,TP,H,H2,HNEW,ALF,LQ;     
     "ARRAY" Y,Z,S1,S2,S3,U1,U3,W1,W2,W3,EHR[1:N],R,RF[1:5,1:N],    
             ERR[1:3],A1,A2[1:N,1:N]; 
     "INTEGER" "ARRAY" PS1,PS2[1:N];  
     "BOOLEAN" START,TWO,HALV;        
     "PROCEDURE" INIVEC(L,U,A,X);             "CODE" 31010;         
     "PROCEDURE" INIMAT(LR,UR,LC,UC,A,X);     "CODE" 31011;         
     "PROCEDURE" MULVEC(L,U,SHIFT,A,B,X);     "CODE" 31020;         
     "PROCEDURE" MULROW(L,U,I,J,A,B,X);       "CODE" 31021;         
     "PROCEDURE" DUPVEC(L,U,SHIFT,A,B);       "CODE" 31030;         
     "PROCEDURE" DUPROWVEC(L,U,I,A,B);        "CODE" 31032;         
     "PROCEDURE" DUPMAT(L,U,I,J,A,B);         "CODE" 31035;         
     "REAL" "PROCEDURE" VECVEC(L,U,SHIFT,A,B);"CODE" 34010;         
     "REAL" "PROCEDURE" MATVEC(L,U,I,A,B);    "CODE" 34011;         
     "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);  "CODE" 34013;         
     "PROCEDURE" ELMVEC(L,U,SHIFT,A,B,X);     "CODE" 34020;         
     "PROCEDURE" ELMROW(L,U,I,J,A,B,X);       "CODE" 34024;         
     "PROCEDURE" DEC(A,N,AUX,P);              "CODE" 34300;         
     "PROCEDURE" SOL(A,N,P,B);                "CODE" 34051;         
        
     "PROCEDURE" DFDY(T,Y,A); "REAL" T; "ARRAY" Y,A;      
     "BEGIN" "INTEGER" I,J; "REAL" SL; "ARRAY" F1,F2[1:N];
         DERIV(T,Y,F1,N);   
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         "BEGIN"  
             SL:="-6*Y[I]; "IF" ABS(SL)<"-6 "THEN" SL:="-6;         
             Y[I]:=Y[I]+SL; DERIV(T,Y,F2,N);    
             "FOR" J:=1 "STEP" 1 "UNTIL" N "DO" 
             A[J,I]:=(F2[J]-F1[J])/SL;
             Y[I]:=Y[I]-SL; 
         "END"    
     "END" DFDY;  
        
     "PROCEDURE" STARTV(Y,T); "VALUE" T; "REAL" T; "ARRAY" Y;       
     "BEGIN" "REAL" A,B,C;  
         A:=(T-T1)/(T1-T2); B:=(T-T2)/(T1-T3);  
         C:=(T-T1)/(T2-T3)*B; B:=A*B; 
         A:=1+A+B; B:=A+C-1;
         MULVEC(1,N,0,Y,S1,A); ELMVEC(1,N,0,Y,S2,-B);     
         ELMVEC(1,N,0,Y,S3,C)         
     "END" STARTV;
        
1SECTION : 5.2.1.1.1.2.F      (OCTOBER 1975)                      PAGE 9      
                                                                  ; 
        
        
     "PROCEDURE" ITERATE(Z,Y,A,H,T,WEIGHTS,FAIL,PS);      
     "ARRAY" Z,Y,A,WEIGHTS; "REAL" H,T; "LABEL" FAIL;     
     "INTEGER" "ARRAY" PS;  
     "BEGIN" "INTEGER" IT,LIT; "REAL" MAX,MAX1,CONV; "ARRAY" DZ,F1[1:N];      
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" Z[I]:=(Z[I]+Y[I])/2;    
         IT:=LIT:=1; CONV:=1;         
     ATER: DERIV(T,Z,F1,N); 
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         F1[I]:=DZ[I]:=Z[I]-H*F1[I]/2-Y[I];     
         SOL(A,N,PS,DZ);    
         ELMVEC(1,N,0,Z,DZ,-1);       
         MAX:=0;  
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         MAX:=MAX+(WEIGHTS[I]*DZ[I])**2;        
         MAX:=SQRT(MAX);    
         "IF" MAX*CONV<EPS/10 "THEN" "GOTO" OUT;
         IT:=IT+1; "IF" IT=2 "THEN" "GOTO" ASS; 
         CONV:=MAX/MAX1;    
         "IF" CONV>.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]<N "THEN" "GOTO" FAIL       
     "END" RECOMP;
        
     "PROCEDURE" INITIALIZATION;      
     "BEGIN" H2:=HNEW; H:=H2/2;       
         DUPVEC(1,N,0,S1,Y0); DUPVEC(1,N,0,S2,Y0); DUPVEC(1,N,0,S3,Y0);       
         DUPVEC(1,N,0,W1,Y0); DUPROWVEC(1,N,1,R,Y0);      
         INIVEC(1,N,U1,0); INIVEC(1,N,W2,0);    
         INIMAT(2,5,1,N,R,0); INIMAT(1,5,1,N,RF,0);       
         T:=T1:=T0; T2:=T0-2*H-"6; T3:=2*T2+1;  
         RECOMP(A1,H,T,S1,MISS,PS1);RECOMP(A2,H2,T,W1,MISS,PS2);    
     "END"        
        
1SECTION : 5.2.1.1.1.2.F      (OCTOBER 1975)                     PAGE 10      
                                                                 ;  
        
        
     "PROCEDURE" ONE LARGE STEP;      
     "BEGIN" STARTV(Z,T+H); 
         ITERATE(Z,S1,A1,H,T+H/2,WEIGHTS,MISS,PS1);       
         DUPVEC(1,N,0,Y,Z); 
         STARTV(Z,T+H2);    
         ITERATE(Z,Y,A1,H,T+3*H/2,WEIGHTS,MISS,PS1);      
         DUPVEC(1,N,0,U3,U1); DUPVEC(1,N,0,U1,Y);         
         DUPVEC(1,N,0,S3,S2); DUPVEC(1,N,0,S2,S1);        
         DUPVEC(1,N,0,S1,Z);
         ELMVEC(1,N,0,Z,W1,1); ELMVEC(1,N,0,Z,S2,-1);     
         ITERATE(Z,W1,A2,H2,T+H,WEIGHTS,MISS,PS2);        
         T3:=T2; T2:=T1; T1:=T+H2;    
         DUPVEC(1,N,0,W3,W2); DUPVEC(1,N,0,W2,W1); DUPVEC(1,N,0,W1,Z);        
     "END";       
        
     "PROCEDURE" CHANGE OF INFORMATION;         
     "BEGIN" "REAL" ALF1,C1,C2,C3; "ARRAY" KOF[2:4,2:4],E,D[1:4];   
         C1:=HNEW/H2; C2:=C1*C1; C3:=C2*C1;     
         KOF[2,2]:=C1; KOF[2,3]:=(C1-C2)/2; KOF[2,4]:=C3/6-C2/2+C1/3;         
         KOF[3,3]:=C2; KOF[3,4]:=C2-C3; KOF[4,4]:=C3;     
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         U1[I]:=R[2,I]+R[3,I]/2+R[4,I]/3;       
         ALF1:=MATVEC(1,N,1,RF,U1)/VECVEC(1,N,0,U1,U1);   
         ALF:=(ALF+ALF1)*C1;
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         "BEGIN"  
             E[1]:=RF[1,I]-ALF1*U1[I];
             E[2]:=RF[2,I]-ALF1*2*R[3,I];       
             E[3]:=RF[3,I]-ALF1*4*R[4,I];       
             E[4]:=RF[4,I]; 
             D[1]:=R[1,I]; RF[1,I]:=E[1]:=E[1]*C2;        
             "FOR" K:=2 "STEP" 1 "UNTIL" 4 "DO" 
             "BEGIN" R[K,I]:=D[K]:=MATMAT(K,4,K,I,KOF,R); 
                 RF[K,I]:=E[K]:=C2*MATVEC(K,4,K,KOF,E)    
             "END" K;       
             S1[I]:=D[1]+E[1];W1[I]:=D[1]+4*E[1];         
             S2[I]:=S1[I]-(D[2]+E[2]/2);        
             S3[I]:=S2[I]-(D[2]+E[2])+(D[3]+E[3]/2);      
         "END" I; 
         T3:=T-HNEW; T2:=T-HNEW/2; T1:=T;       
         H2:=HNEW; H:=H2/2; ERR[1]:=0;
         "IF" HALV "THEN"   
         "BEGIN" DUPVEC(1,N,0,PS2,PS1); DUPMAT(1,N,1,N,A2,A1) "END";
         "IF" TWO "THEN"    
         "BEGIN" DUPVEC(1,N,0,PS1,PS2); DUPMAT(1,N,1,N,A1,A2)       
         "END" "ELSE" RECOMP(A1,HNEW/2,T,S1,MISS,PS1);    
         "IF" ^HALV "THEN" RECOMP(A2,HNEW,T,W1,MISS,PS2); 
     "END";
1SECTION : 5.2.1.1.1.2.F      (OCTOBER 1975)                     PAGE 11      
                                                                 ;  
        
        
        
     "PROCEDURE" BACKWARD DIFFERENCES;
     "FOR"I:=1 "STEP" 1 "UNTIL" N "DO"
     "BEGIN" "REAL" B0,B1,B2,B3;      
         B1:=(U1[I]+2*S2[I]+U3[I])/4; 
         B2:=(W1[I]+2*W2[I]+W3[I])/4; 
         B3:=(S3[I]+2*U3[I]+S2[I])/4; 
         B2:=(B2-B1)/3; B0:=B1-B2;    
         B2:=B2-(S1[I]-2*S2[I]+S3[I])/16;       
         B1:=2*B3-(B2+RF[1,I])-(B0+R[1,I])/2;   
         B3:=0;   
         "FOR" K:=1 "STEP" 1 "UNTIL" 4 "DO"     
         "BEGIN" B1:=B1-B3; B3:=R[K,I]; R[K,I]:=B0; B0:=B0-B1       
         "END"; R[5,I]:=B0; 
         "FOR" K:=1 "STEP" 1 "UNTIL" 4 "DO"     
         "BEGIN" B3:=RF[K,I]; RF[K,I]:=B2; B2:=B2-B3 "END";         
         RF[5,I]:=B2;       
     "END";       
        
     "PROCEDURE" ERROR ESTIMATES;     
     "BEGIN" "REAL" C0,C1,C2,C3,B0,B1,B2,B3,W,SL1,SN,LR;  
         C0:=C1:=C2:=C3:=0; 
         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"     
         "BEGIN" W:=WEIGHTS[I]**2;    
             B0:=RF[4,I]/36; C0:=C0+B0*B0*W; LR:=ABS(B0); 
             B1:=RF[1,I]+ALF*R[2,I]; C1:=C1+B1*B1*W;      
             B2:=RF[3,I]; C2:=C2+B2*B2*W;       
             SL1:=ABS(RF[1,I]-RF[2,I]);         
             SN:="IF" SL1<"-10 "THEN"1"ELSE"ABS(RF[1,I]-R[4,I]/6)/SL1;        
             "IF" SN>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<B1 "THEN" B1"ELSE" B0);         
         "IF" B0<B1 "AND" LQ>=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";        
        
1SECTION : 5.2.1.1.1.2.F      (OCTOBER 1975)                     PAGE 12      
                                                                 ;  
        
        
     "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-T<HNEW "THEN" HNEW:=TEND-T;         
         TWO:=HNEW=2*H2;    
     "END";       
        
     "IF" PRESCH "THEN" H:=H0 "ELSE"  
     "BEGIN" "IF" H0>HMAX "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" T<TEND+H2 "THEN" "GOTO" MSTP "ELSE" "GOTO" END; 
 MISS: FAIL:=PRESCH;        
     "IF" ^ FAIL "THEN"     
     "BEGIN" "IF" ECI>1 "THEN" T:=T-H2;         
         HALV:=TWO:="FALSE"; HNEW:=H2/2;        
         "IF" START "THEN" "GOTO" INIT "ELSE" "GOTO" TRYCK
     "END";       
 END:   
 "END" IMPEX;     
================== 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;
================== 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;
================== 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;                     "COMMENT"
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 14
                                                                 ;
  
  
             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;
================== 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;                     "COMMENT"
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 15
                                                                 ;
  
  
             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;
================== 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;       
================== 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;
 
1SECTION : 5.1.2.2.2 
                                                                  ;
 
 
     "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"T2<SMALL"THEN"T2:= SMALL;
         "IF"T2>0.01*H "THEN"T2:= 0.01*H;
         "IF"FK"AND"F1<=FM "THEN"
         "BEGIN"XM:=X1; FM:= F1 "END";
         "IF" ^ FK"OR"ABS(X1)<T2"THEN"
         "BEGIN"X1:="IF"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;
                                                               "COMMENT"
1SECTION : 5.1.2.2.2          (DECEMBER 1979)                     PAGE 7
                                                                  ;
 
 
     L1: F2:=FLIN(X2);
         "IF"K<NITS"AND"F2>F0"THEN"
         "BEGIN"K:=K+1;
             "IF"F0<F1"AND"X1*X2>0"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"SF1<FX"THEN"
         "BEGIN" FX:=SF1; X1:=SX1 "END";
         "IF"J>0"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);
                                                               "COMMENT"
1SECTION : 5.1.2.2.2          (DECEMBER 1979)                     PAGE 8
                                                                  ;
 
 
     ABSTOL:=T2:= SMALL+ABS(ABSTOL); DMIN:= SMALL;
     "IF" H<ABSTOL*100"THEN"H:=ABSTOL*100; LDT:=H;
     INIMAT(1,N,1,N,V,0);
     "FOR"I:=1"STEP"1"UNTIL"N"DO"V[I,I]:= 1;
     D[1]:= QD0:= 0; DUPVEC(1,N,0,Q1,X);
     INIVEC(1,N,Q0,0);
 
 
     "COMMENT"MAIN LOOP;
 L0: SF:=D[1]; D[1]:= S:= 0;
     MIN(1,2,D[1],S,FX,"FALSE");
     "IF" S <= 0 "THEN" MULCOL(1, N, 1, 1, V, V, -1);
     "IF" SF <= 0.9 * D[1] "OR" 0.9 * SF >= 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<S"THEN"
             "BEGIN"DF:=S;KL:= K2"END";
         "END";
         "IF" ^ILLC "AND" DF < ABS(100 * MACHEPS * FX) "THEN"
         "BEGIN" ILLC:= "TRUE"; "GOTO" L1 "END";
         "FOR" K2:= 1"STEP" 1"UNTIL"K-1"DO"
         "BEGIN" S:= 0; MIN(K2, 2, D[K2], S, FX, "FALSE") "END";
         F1:= FX; FX:= SF; LDS:= 0;
         "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
         "BEGIN" SL:= X[I]; X[I]:= Y[I]; SL:= Y[I]:= SL - Y[I];
             LDS:= LDS + SL * SL
         "END"; LDS:= SQRT(LDS);
         "IF" LDS > 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;
                                                               "COMMENT"
1SECTION : 5.1.2.2.2 
                                                                  ;
 
 
         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"DN<D[I]"THEN"DN:=D[I]
     "END";
     "FOR"J:= 1"STEP"1"UNTIL"N"DO"
     "BEGIN"S:= D[J]/DN; MULCOL(1,N,J,J,V,V,S)"END";
     "IF"SCBD>1"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"SL<M4"THEN"Z[I]:= M4;
             "IF" S>SL "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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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";  
                                                               "COMMENT"      
1SECTION : 6.10.4 
                                                                  ; 
        
        
          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;     
================== 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; 
================== 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;
================== 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;
================== 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 ;
================== 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 ;
================== 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;
                                                               "COMMENT"
1SECTION : 4.2.2 
                                                                  ;
 
 
                "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;
================== 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;
        
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
       "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; 
        
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
             "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;     
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
             "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; 
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
                         "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; 
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
                         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";   
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
                   "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])<EPS1 "THEN"  
                         "BEGIN" NBP:=NBP-1; DUPVEC(JJ,NBP,1,BP,BP);
                            BP[NBP+1]:=0
                         "END" "ELSE" 
                         "BEGIN" EXTRA:=EXTRA+1;
                            "IF" FIRST "THEN" PAR[M+JJ]:=OBS[II];   
                            "COMMENT" INTRODUCING A JACOBIAN ROW AND A
                                      RESIDUAL VECTOR ELEMENT FOR   
                                      CONTINUITY REQUIREMENTS;      
                            YP[NOBS+JJ,M+JJ]:=-WEIGHT;    
                            MULROW(1,NPAR,NOBS+JJ,II,YP,YP,WEIGHT); 
                            RES[NOBS+JJ]:=WEIGHT*(RES[II]+OBS[II]-  
                                          PAR[M+JJ])      
                         "END"
                      "END";
        
                      "IF" II=NOBS "THEN" "GOTO" RETURN "ELSE"      
                      "BEGIN" T:=TOBS[II+1];    
                         "IF" BP[JJ]=II "AND" JJ<NBP "THEN" JJ:=JJ+1; 
                         HMAX:=T-TOBS[II]; HMIN:=HMAX*IN[1]; II:=II+1 
                      "END";
                   "END";   
        
                   "COMMENT" BREAK-POINTS INTRODUCE NEW INITIAL VALUES
                             FOR Y AND YP;      
                   "IF" EXTRA>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;  
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
                         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;       
                                                               "COMMENT"      
1SECTION : 5.2.1.3.1 
                                                                 ;  
        
        
        
          "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])<EPS1  
                "THEN"      
                "BEGIN" NBP:=NBP-1; DUPVEC(J,NBP,1,BP,BP);
                   DUPVEC(J+M,NBP+M,1,PAR,PAR); 
                   J:=J-1; AWAY:=AWAY+1; BP[NBP+1]:=0     
                "END"       
             "END"; 
             NCOL:=NCOL-AWAY; NROW:=NROW-AWAY   
          "END";  
        
          IN[3]:=IN3; IN[4]:=IN4; NBP:=0; WEIGHT:=1;      
          MONITOR(2,M,NOBS,PAR,RES,WEIGHT,NIS); 
          MARQUARDT(NOBS,M,PAR,RES,JTJINV,FUNCT,JAC DYDP,IN,OUT);   
          NFE:=OUT[4]+NFE   
       "END";     
      ESCAPE: "IF" OUT[1]=3 "THEN" OUT[1]:=2 "ELSE"       
              "IF" OUT[1]=4 "THEN" OUT[1]:=6;   
              "IF" SAVE[-3]^=0 "THEN" OUT[1]:=SAVE[-3];   
              OUT[3]:=RES1; 
              OUT[4]:=NFE;  
              OUT[5]:=MAX   
    "END" PEIDE;  
================== 33300 =================
  "PROCEDURE" FEM LAG SYM(X, Y, N, P, R, F, ORDER, E);
  "INTEGER" N, ORDER;
  "REAL" "PROCEDURE" P, R, F;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1;
    "REAL" XL1, XL, H, A12, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
        P1, P2, P3, P4, R1, R2, R3, R4, F1, F2, F3, F4,
        E1, E2, E3, E4, E5, E6;
    "ARRAY" T, SUB, CHI, GI[0:N-1];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "REAL"  H2;
        "IF" L=1 "THEN"
        "BEGIN" P2:= P(XL1); R2:= R(XL1); F2:= F(XL1) "END";
        P1:= P2; P2:= P(XL); R1:= R2; R2:= R(XL); F1:= F2; F2:= F(XL);
        H2:= H/2; B1:= H2*F1; B2:= H2*F2; TAU1:= H2*R1; TAU2:= H2*R2;
        A12:= -0.5*(P1 + P2)/H
    "END" ELAN. M.V. EV.;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 2;
    "BEGIN" "REAL"  X2, H6, H15, B3, TAU3, C12, C32, A13, A22, A23;
        "IF" L=1 "THEN"
        "BEGIN" P3:= P(XL1); R3:= R(XL1); F3:= F(XL1) "END";
        X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5;
        P1:= P3; P2:= P(X2); P3:= P(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;
        A12:= -(2*P1 + P3/1.5)/H; A13:= (0.5*(P1 + P3) - P2/1.5)/H;
        A22:= (P1 + P3)/H/0.375 + TAU2; A23:= -(P1/3 + P3)*2/H;
        "COMMENT" STATIC CONDENSATION;
        C12:= - A12/A22; C32:= - A23/A22; A12:= A13 + C32*A12;
        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" "REAL"  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" P4:= P(XL1); R4:= R(XL1); F4:= F(XL1) "END";
        X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1;
        H12:= H/12; H24:= H/2.4;
        P1:= P4; P2:= P(X2); P3:= P(X3); P4:= P(XL);
        R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL);
        F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL);
        B1:= H12*F1; B2:= H24*F2; B3:= H24*F3; B4:= H12*F4;
        TAU1:= H12*R1; TAU2:= H24*R2; TAU3:= H24*R3; TAU4:= H12*R4;
                                                               "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 15
                                                                 ;
 
 
        A12:= -(+ 4.04508497187450*P1
                + 0.57581917135425*P3
                + 0.25751416197911*P4)/H;
        A13:= (+ 1.5450849718747*P1
               - 1.5075141619791*P2
               + 0.6741808286458*P4)/H;
        A14:= ((P2 + P3)/2.4 - (P1 + P4)/2)/H;
        A22:= (5.454237476562*P1 + P3/.48 +.79576252343762*P4)/H + TAU2;
        A23:= - (P1 + P4)/(H*0.48);
        A24:= (+ 0.67418082864575*P1
               - 1.50751416197910*P3
               + 1.54508497187470*P4)/H;
        A33:= (.7957625234376*P1 + P2/.48 + 5.454237476562*P4)/H + TAU3;
        A34:= -(+ 0.25751416197911*P1
                + 0.57581917135418*P2
                + 4.0450849718747*P4)/H;
        "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 EVALUATION 3;
 
    "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" "REAL" AUX; AUX:= P1/E2; TAU1:= TAU1 - AUX*E1 ;
        B1:= B1 - E3*AUX
    "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" "REAL" AUX; AUX:= P2/E5;
        TAU2:= TAU2 + AUX*E4; B2:= B2 + AUX*E6
    "END" B.C.1;
 
    "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;
                                                               "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 16
                                                                 ;
 
 
        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 LAG SYM;
================== 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;
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 17
                                                                 ;
 
 
    "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;
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 18
                                                                 ;
 
 
    "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;
================== 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;
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 7
                                                                  ;
  
  
    "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;
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 8
                                                                  ;
  
  
    "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;
================== 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;
                                                               "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                  ;
  
  
        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"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                  ;
  
  
        "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"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                 ;
  
  
        "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"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                 ;
  
  
        "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"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                 ;
  
  
        "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"
1SECTION : 5.2.1.2.1.2.2.1 
                                                                 ;
  
  
        "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"L<N"DO"
    "BEGIN" XL1:= XL; XL:= X[L];
      ELEMENTMATVECEVALUATION;
      A[W + 1]:= D1 + A11; A[W + 4]:= E1 + A12;
      A[W + 7]:= A13; A[W + 10]:= A14;
      A[W + 5]:= D2 + A22; A[W + 8]:= A23;
      A[W + 11]:= A24; A[W + 14]:= 0;
      Y[V + 1]:= R1 + B1; Y[V + 2]:= R2 + B2;
      R1:= B3; R2:= B4; V:= V + 2; W:= W + 8;
      D1:= A33; D2:= A44; E1:= A34
    "END";
    L:= N; XL1:= XL; XL:= X[L]; ELEMENTMATVECEVALUATION;
    Y[N2      - 1]:= R1 + B1 - A13*YB - A14*ZB;
    Y[N2]:= R2 + B2 - A23*YB - A24*ZB;
      A[W + 1]:= D1 + A11; A[W + 4]:= E1 + A12; A[W + 5]:= D2 + A22;
    CHLDECSOLBND(A, N2, 3, EM, Y)
  "END" FEMHERM;
================== 34600 =================
 "PROCEDURE" QZIVAL(N,A,B,ALFR,ALFI,BETA,ITER,EM);
 "VALUE" N;"INTEGER" N;"ARRAY" A,B,ALFR,ALFI,BETA,EM;     
 "INTEGER" "ARRAY" ITER;    
 "BEGIN" "REAL" DWARF,EPS,EPSA,EPSB;  
 "PROCEDURE" ELMCOL(L,U,I,J,A,B,X);"CODE" 34023;
 "PROCEDURE" HSHDECMUL(N,A,B,DWARF);"CODE" 34602; 
 "PROCEDURE" HESTGL2(N,A,B);"CODE" 34604;       
 "PROCEDURE" HSH2ROW2(LA,LB,UA,UB,J,A1,A2,A,B);"CODE" 34608;
 "PROCEDURE" HSH3ROW2(LA,LB,U,J,A1,A2,A3,A,B);"CODE" 34610; 
 "PROCEDURE" HSH2COL(LA,LB,U,I,A1,A2,A,B);"CODE" 34605;   
 "PROCEDURE" HSH3COL(LA,LB,U,I,A1,A2,A3,A,B);"CODE" 34606;
 "PROCEDURE" CHSH2(A1R,A1I,A2R,A2I,C,SR,SI);"CODE" 34611; 
 "PROCEDURE" HSHVECMAT(LR,UR,LC,UC,X,U,A);"CODE" 31070;   
 "PROCEDURE" HSHVECTAM(LR,UR,LC,UC,X,U,A);"CODE" 31073;   
 "PROCEDURE" QZIT(N,A,B,EPS,EPSA,EPSB,ITER);"VALUE"N,EPS; 
 "REAL" EPS,EPSA,EPSB;"INTEGER" N;"INTEGER" "ARRAY" ITER;"ARRAY" A,B; 
 "BEGIN" "REAL" ANORM,BNORM,ANI,BNI,CONST,A10,A20,A30,B11,
     B22,B33,B44,A11,A12,A21,A22,A33,A34,A43,A44,B12,B34,OLD1,OLD2; 
     "INTEGER" I,Q,M,M1,Q1,J,K,K1,K2,K3,KM1;"BOOLEAN" STATIONARY;   
     ANORM:=BNORM:=0;"FOR" I:=1 "STEP" 1 "UNTIL" N "DO"   
     "BEGIN" BNI:=0;ITER[I]:=0;ANI:="IF" I>1"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])<EPSB "THEN"EPSB
             "ELSE" B[Q1,Q1]; 
             B33:="IF" ABS(B[M1,M1])<EPSB "THEN" EPSB "ELSE"B[M1,M1]; 
                                                               "COMMENT"      
1SECTION : 3.4.1.2 
                                                                 ;  
        
        
             B44:="IF" ABS(B[M,M])<EPSB "THEN" EPSB "ELSE" B[M,M] ; 
             A11:=A[Q,Q]/B11;A12:=A[Q,Q1]/B22;A21:=A[Q1,Q]/B11;     
             A22:=A[Q1,Q1]/B22;A33:=A[M1,M1]/B33;A34:=A[M1,M]/B44;  
             A43:=A[M,M1]/B33;A44:=A[M,M]/B44;B12:=B[Q,Q1]/B22;     
             B34:=B[M1,M]/B44;
             A10:=((A33-A11)*(A44-A11)-A34*A43+A43*B34*A11)/A21     
                  +A12-A11*B12;       
             A20:=(A22-A11-A21*B12)-(A33-A11)-(A44-A11)+A43*B34;    
             A30:=A[Q+2,Q1]/B22       
         "END";OLD1:=ABS(A[M,M-1]);OLD2:=ABS(A[M-1,M-2]); 
         "FOR" K:=Q "STEP" 1 "UNTIL" M1 "DO"    
         "BEGIN" K1:=K+1;K2:=K+2;K3:="IF" K+3>M "THEN" M "ELSE" K+3;
             KM1:="IF" K-1<Q "THEN" Q "ELSE" K-1; 
             "IF" K^=M1 "THEN"
             "BEGIN" "IF" K=Q "THEN"  
                 "BEGIN"    
                  HSH3COL(KM1,KM1,M,K,A[K,KM1],A[K1,KM1],A[K2,KM1],A,B);      
                   A[K1,KM1]:=A[K2,KM1]:=0      
                 "END";     
                 HSH3ROW2(Q,Q,K3,K,B[K2,K2],B[K2,K1],B[K2,K],A,B);  
                 B[K2,K]:=B[K2,K1]:=0 ; 
             "END" "ELSE"   
             "BEGIN" HSH2COL(KM1,KM1,M,K,A[K,KM1],A[K1,KM1],A,B);   
                 A[K1,KM1]:=0 
             "END"; 
             HSH2ROW2(Q,Q,K3,K3,K,B[K1,K1],B[K1,K],A,B);B[K1,K]:=0  
         "END"    
     "END";       
     OUT: 
   "END"
 "END" QZIT;      
================== 34601 =================
 "PROCEDURE" QZI(N,A,B,X,ALFR,ALFI,BETA,ITER,EM); 
 "VALUE" N;"INTEGER" N;"ARRAY"A,B,X,ALFR,ALFI,BETA,EM;    
 "INTEGER" "ARRAY" ITER;    
 "BEGIN" "REAL" DWARF,EPS,EPSA,EPSB;  
 "REAL" "PROCEDURE" MATMAT(L,U,I,J,A,B);"CODE" 34013;     
 "PROCEDURE" HSHDECMUL(N,A,B,DWARF);"CODE" 34602; 
 "PROCEDURE" HESTGL3(N,A,B,X);"CODE" 34603;     
 "PROCEDURE" HSH2ROW3(L,UA,UB,UX,J,A1,A2,A,B,X);"CODE" 34607;       
 "PROCEDURE" HSH3ROW3(L,U,UX,J,A1,A2,A3,A,B,X);"CODE" 34609;
 "PROCEDURE" HSH2COL(LA,LB,U,I,A1,A2,A,B);"CODE" 34605;   
 "PROCEDURE" HSH3COL(LA,LB,U,I,A1,A2,A3,A,B);"CODE" 34606;
 "PROCEDURE" CHSH2(A1R,A1I,A2R,A2I,C,SR,SI);"CODE" 34611; 
 "PROCEDURE" COMDIV(XR,XI,YR,YI,ZR,ZI);"CODE" 34342;      
 "PROCEDURE" QZIT(N,A,B,X,EPS,EPSA,EPSB,ITER);"VALUE"N,EPS; 
 "REAL" EPS,EPSA,EPSB;"INTEGER" N;"INTEGER" "ARRAY" ITER;"ARRAY" A,B,X;       
 "BEGIN" "REAL" ANORM,BNORM,ANI,BNI,CONST,A10,A20,A30,B11,
     B22,B33,B44,A11,A12,A21,A22,A33,A34,A43,A44,B12,B34,OLD1,OLD2; 
     "INTEGER" I,Q,M,M1,Q1,J,K,K1,K2,K3,KM1;"BOOLEAN" STATIONARY;   
     ANORM:=BNORM:=0;"FOR" I:=1 "STEP" 1 "UNTIL" N "DO"   
     "BEGIN" BNI:=0;ITER[I]:=0;ANI:="IF" I>1"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])<EPSB "THEN"EPSB
             "ELSE" B[Q1,Q1]; 
                                                               "COMMENT"      
1SECTION : 3.4.1.2 
                                                                 ;  
        
        
             B33:="IF" ABS(B[M1,M1])<EPSB "THEN" EPSB "ELSE"B[M1,M1]; 
             B44:="IF" ABS(B[M,M])<EPSB "THEN" EPSB "ELSE" B[M,M] ; 
             A11:=A[Q,Q]/B11;A12:=A[Q,Q1]/B22;A21:=A[Q1,Q]/B11;     
             A22:=A[Q1,Q1]/B22;A33:=A[M1,M1]/B33;A34:=A[M1,M]/B44;  
             A43:=A[M,M1]/B33;A44:=A[M,M]/B44;B12:=B[Q,Q1]/B22;     
             B34:=B[M1,M]/B44;
             A10:=((A33-A11)*(A44-A11)-A34*A43+A43*B34*A11)/A21     
                  +A12-A11*B12;       
             A20:=(A22-A11-A21*B12)-(A33-A11)-(A44-A11)+A43*B34;    
             A30:=A[Q+2,Q1]/B22       
         "END";OLD1:=ABS(A[M,M-1]);OLD2:=ABS(A[M-1,M-2]); 
         "FOR" K:=Q "STEP" 1 "UNTIL" M1 "DO"    
         "BEGIN" K1:=K+1;K2:=K+2;K3:="IF" K+3>M "THEN" M "ELSE" K+3;
             KM1:="IF" K-1<Q "THEN" Q "ELSE" K-1; 
             "IF" K^=M1 "THEN"
             "BEGIN" "IF" K=Q "THEN"  
                 HSH3COL(KM1,KM1,N,K,A10,A20,A30,A,B) "ELSE"
                 "BEGIN"    
                  HSH3COL(KM1,KM1,N,K,A[K,KM1],A[K1,KM1],A[K2,KM1],A,B);      
                   A[K1,KM1]:=A[K2,KM1]:=0      
                 "END";     
                 HSH3ROW3(1,K3,N,K,B[K2,K2],B[K2,K1],B[K2,K],A,B,X);
                 B[K2,K]:=B[K2,K1]:=0 ; 
             "END" "ELSE"   
             "BEGIN" HSH2COL(KM1,KM1,N,K,A[K,KM1],A[K1,KM1],A,B);   
                 A[K1,KM1]:=0 
             "END"; 
             HSH2ROW3(1,K3,K3,N,K,B[K1,K1],B[K1,K],A,B,X);B[K1,K]:=0
         "END"    
     "END"
   "END"; OUT:    
 "END" QZIT;      
 "PROCEDURE" QZVAL(N,A,B,X,EPSA,EPSB,ALFR,ALFI,BETA);"VALUE" N;     
 "REAL" EPSA,EPSB;"INTEGER" N;"ARRAY" ALFR,ALFI,BETA,A,B,X; 
 "BEGIN" "INTEGER" M,L,J;"REAL" AN,BN,A11,A12,A21,A22,B11,B12,B22,E,C,D,      
     ER,EI,A11R,A11I,A12R,A12I,A21R,A21I,A22R,A22I,CZ,SZR,SZI,      
     CQ,SQR,SQI,SSR,SSI,TR,TI,BDR,BDI,R;
     "FOR" M:=N,M "WHILE" M>0 "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]);       
                                                               "COMMENT"      
1SECTION : 3.4.1.2 
                                                                 ;  
        
        
         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      
================== 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; 
================== 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;   
================== 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;   
================== 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;   
================== 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;   
================== 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;  
================== 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;  
================== 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;  
================== 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;  
================== 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";
================== 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";
================== 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";
================== 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";
================== 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";
================== 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";
================== 30006 =================
 "REAL" "PROCEDURE" PI;
 PI:= 3.14159265358979;
================== 30007 =================
 "REAL" "PROCEDURE" E;
 E:= 2.71828182845905;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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;
================== 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.;
 
 
                                                               "COMMENT"
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 7
                                                                       ;
 
 
    "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;
                                                               "COMMENT"
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 8
                                                                       ;
 
 
    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;
