DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »cstrtxt«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »cstrtxt« 

TextFile

program for integrating of CSTR model with chstiffp
18 03 82 15 00 00
begin
     zone bs(2*128,2,stderror);
     integer i,s,ndata;
     real date,clock,
          d,e,r,k,b,zc,g,a;
     integer array TAIL(1:10);
     long array OS,BS(1:3);

procedure fjac(bjac,X,t,F,A);
boolean bjac;
real t;
real array X,F,A;
begin real x,y,z,eta,the,etap,thep;
     x:= X(1); y:= X(2); z:= X(3);
     eta:= exp(z/(1+e*z));
     the:= eta**k;
     F(1):= 1-x-d*x*eta;
     F(2):= -y+d*x*eta-d*r*y*the;
     F(3):= -z-b*(z-zc)+d*g*x*eta+d*g*a*r*y*the;
     if bjac then
     begin etap:= eta/(1+e*z)*(1-e*z/(1+e*z));
        thep:= k*eta**(k-1)*etap;
        A(1,1):= -1-d*eta;
        A(1,2):= 0;
        A(1,3):= -d*x*etap;
        A(2,1):= d*eta;
        A(2,2):= -1-d*r*eta;
        A(2,3):= d*x*etap-d*r*y*thep;
        A(3,1):= d*e*eta;
        A(3,2):= d*g*a*r*the;
        A(3,3):= -1-b+d*g*x*etap+d*g*a*r*y*thep;
     end;
end;

procedure xin(X,tb,dt,te,h,eps);
real tb,dt,te,h,eps;
real array X;
begin read(in,X);
     read(in,d,e,r,k,b,zc,g,a);
     read(in,tb,dt,te,h,eps);
     for i:= 1,2 do
     begin
        case i of begin
           begin fpproc(29,0,out,OS); fpproc(28,i,out,BS); end;
           begin setposition(out,0,0); fpproc(30,0,out,OS) end;
        end case;
        write(out,<:<10>:>,<<-d.dd'-dd>,
           <:    d=:>,d,<:    e=:>,e,<:    r=:>,r,<:    k=:>,k,
           <:<10>:>,
           <:    b=:>,b,<:   zc=:>,zc,<:    g=:>,g,<:    a:>,a,
           <:<10>:>,
           <:     x=:>,X(1),<:     y=:>,X(2),<:     z=:>,X(3),
           <:<10><10>:>,
           <:   tid       h:>,
           <:         x          y          z:>,
           <:<10><25>:>,false,3);
     end i;
     swoprec(bs,128);
     bs(124):= 0; bs(125):= date; bs(126):= clock;
     bs(127):= -1; bs(128):= 6;
     setposition(bs,0,1);
end;

procedure xout(X,t,h,s);
integer s;
real t,h;
real array X;
begin
     if opkey then
     begin
        write(out,<:<10>:>,<<-d>,s,<< dddd.d>,t,
           <<  d.d'-d>,h,<<  -d.dd'-dd>,X(1),X(2),X(3));
        setposition(out,0,0);
     end;
     outrec(bs,6);
     bs(1):= s; bs(2):= t; bs(3):= h;
     for i:= 1 step 1 until 3 do bs(3+i):= X(i);
     ndata:= ndata+1;
end;
     systime(1,0,date); date:=systime(2,date,clock);
     BS(1):= long<:kemda:>add 116; BS(2):= long <:a:>;
     open(bs,4,BS,0);
     monitor(42,bs,i,TAIL);
     outrec(bs,128);
     for i:= 1 step 1 until 128 do bs(i):= 0;
     for i:= 2 step 1 until TAIL(1) do outrec(bs,128);
     setposition(bs,0,0);
     ndata:= 0;
     chstiffp(3,fjac,xin,xout);
     setposition(bs,0,0);
     swoprec(bs,128);
     bs(127):= ndata;
     close(bs,true);
end;
▶EOF◀