code 33066; procedure ARKMAT( T, TE, M, N, U, DER, TYPE, ORDER, SPR, OUT); value M,N,TYPE,ORDER; integer M,N,TYPE,ORDER; real T,TE,SPR; array U; procedure DER,OUT; begin integer SIG,L; real TAU; array LAMBDA[1:9],UH,DU[1:N,1:M]; boolean LAST; procedure ELMMAT(A,B,X); value X; array A,B; real X; for L:=1 step 1 until M do ELMCOL(1,N,L,L,A,B,X); procedure INITIALIZE; begin integer I;real LBD; switch TYPEODE:=NOTSPECIFIED2,PARABOLIC1,PARABOLIC2,HYPERBOLIC2; if TYPE^=2 and TYPE^=3 then TYPE:=1; if TYPE^=2 then ORDER:=2 else if ORDER^=2 then ORDER:=1; I:=1; goto TYPEODE[if TYPE=1 then 1 else TYPE+ORDER-1]; NOTSPECIFIED2: for LBD:=1/9,1/8,1/7,1/6,1/5,1/4,1/3,1/2,4.3 do begin LAMBDA[I]:=LBD; I:=I+1 end; goto EXIT; PARABOLIC1: for LBD:=.1418519249"-2,.3404154076"-2,.0063118569 ,.01082794375,.01842733851,.03278507942, .0653627415,.1691078577,156 do begin LAMBDA[I]:=LBD; I:=I+1 end; goto EXIT; PARABOLIC2: for LBD:=.3534355908"-2,.8532600867"-2,.015956206 ,.02772229155,.04812587964,.08848689452, .1863578961,.5,64 do begin LAMBDA[I]:=LBD; I:=I+1 end; goto EXIT; HYPERBOLIC2: for LBD:=1/8,1/20,5/32,2/17,17/80,5/22,11/32,1/2, 8 do begin LAMBDA[I]:=LBD; I:=I+1 end; goto EXIT; EXIT: SIG:=SIGN(TE-T) end INITIALIZE; procedure DIFFERENCE SCHEME; begin integer I;real MLT; DER(T,U,DU); for I:=1 step 1 until 8 do begin MLT:=LAMBDA[I]*TAU; DUPMAT(1,N,1,M,UH,U); ELMMAT(UH,DU,MLT); DER(T+MLT,UH,DU) end; ELMMAT(U,DU,TAU); T:=if LAST then TE else T+TAU; end DIFFERENCE SCHEME; INITIALIZE; LAST:=false; STEP: TAU:=(if SPR=0 then ABS(TE-T) else ABS(LAMBDA[9]/SPR))*SIG; if T+TAU >= TE eqv TAU>=0 then begin TAU:=TE-T;LAST:=true end; DIFFERENCE SCHEME ; OUT; if not LAST then goto STEP end ARKMAT; eop