DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »chstiff1txt«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »chstiff1txt« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »chstiff1txt« 

TextFile

chstiff=set 16
chstiff=algol list.yes
external integer procedure chstiff(n,X,t,tend,fjac,h,eps);
value n,tend,eps;
integer n;
real t,tend,h,eps;
real array X;
procedure fjac;
begin
     integer i,j;
     real r,q;
     boolean test;
     integer array P(1:n);
     real array XH,X2H,XH2,K1,K2(1:n),A(1:n,1:n);

procedure chstep(X,h,Y);
value h;
real h;
real array X,Y;
begin fjac(true,X,t,K1,A);
     for i:= 1 step 1 until n do
     for j:= 1 step 1 until n do
        A(i,j):= -0.788675184*A(i,j);
     for i:= 1 step 1 until n do A(i,i):= 1/h+A(i,i);
     if -,decompose(A,P,0) then
     begin chstiff:= -1; goto chexit end;
     solve(A,P,0,K1);
     for i:= 1 step 1 until n do 
        Y(i):= X(i)-1.15470054*K1(i);
     fjac(false,Y,t,K2,A);
     solve(A,P,0,K2);
     for i:= 1 step 1 until n do
        Y(i):= X(i)+0.75*K1(i)+0.25*K2(i);
end chstep;

     chstiff:= 0; test:= false;
     if h>0.5*(tend-t) then h:= 0.5*(tend-t); 
rep: chstep(X,h,XH);
     chstep(XH,h,XH2);
     chstep(X,2*h,X2H);
     r:= 0;
     for i:= 1 step 1 until n do
     if X(i)<>0 then
     begin q:= abs(X2H(i)-XH2(i))/X(i);
        if q>r then r:= q;
     end;
     if r<>0 then q:= h*(14*eps/r)**0.25
     else q:= (tend-t)/2;
     if test then write(out,<:<10>h = :>,q);
     if q<0.8*h then
     begin h:= q; goto rep end;
     if t+h<=tend then
     begin t:= t+h; 
        for i:= 1 step 1 until n do X(i):= XH(i);
        if t+q<tend then h:= q;
        if t<tend then goto rep;
     end else
     begin chstep(X,tend-t,XH);
        t:= tend;
        for i:= 1 step 1 until n do
        X(i):= XH(i) ;
     end;
chexit:
end;
end;
▶EOF◀