DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦fbddfe7d7⟧ TextFile

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »cho7txt«

Derivation

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

TextFile

program for integrating of open oregonator model with chstiff
28 03 80 17 30 00
begin
     zone bs(2*128,2,stderror);
     integer i,s,ndata;
     real date,clock,
          a,k1,k2,k3,k4,k5,k6,k7,km1,km2,j;
     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 w1,w2,w3,w4,w5,w6,w7,x,y,z,u,v,
        w1x,w1y,w2x,w2y,w3x,w4x,w1u,w2u,w5u,w6z,w7z,w6v;
     x:= X(1); y:= X(2); z:= X(3); u:= X(4); v:=X(5);
     w1:= k1*a*y-km1*x*u;
     w2:= k2*x*y-km2*u*u;
     w3:= k3*a*x;
     w4:= k4*x*x;
     w5:= k5*u;
     w6:=k6*v*z;
     w7:=k7*z;
     F(1):= w1-w2+w3-2*w4-j*x;
     F(2):= -w1-w2+w6-j*y;
     F(3):= 2*w3-4*w6-6*w7-j*z;
     F(4):= w1+2*w2+w4-w5-j*u;
     F(5):= w5-w6-j*v;
     if bjac then
     begin w1x:= -km1*u; w1y:= k1*a; w1u:= -km1*x;
        w2x:= k2*y; w2y:= k2*x; w2u:= -2*km2*u;
        w3x:= k3*a; w4x:= 2*k4*x; w5u:= k5;
        w6z:= k6*v; w7z:= k7;
        w6v:= k6*z;
        A(1,1):= w1x-w2x+w3x-2*w4x-j;
        A(1,2):= w1y-w2y;
        A(1,3):= 0;
        A(1,4):= w1u-w2u;
        A(1,5):= 0;
        A(2,1):= -w1x-w2x;
        A(2,2):= -w1y-w2y-j;
        A(2,3):= w6z;
        A(2,4):= -w1u-w2u;
        A(2,5):= w6v;
        A(3,1):= 2*w3x;
        A(3,2):= 0;
        A(3,3):= -4*w6z-6*w7z-j;
        A(3,4):= 0;
        A(3,5):= -4*w6v;
        A(4,1):= w1x+2*w2x+w4x;
        A(4,2):= w1y+2*w2y;
        A(4,3):= 0;
        A(4,4):= w1u+2*w2u-w5u-j;
        A(4,5):= 0;
        A(5,1):= 0;
        A(5,2):= 0;
        A(5,3):= -w6z;
        A(5,4):= w5u;
        A(5,5):= -w6v-j;
     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,a,k1,k2,k3,k4,k5,k6,k7,km1,km2,j);
     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'-d>,<:A+Y<=>X+U    X+Y<=>2U:>,
          <:    A+X->2X+2Z    2X->U    U->V    V+4Z->Y    6Z->P:>,
          <:<10><10>k1=:>,k1,<:   km1=:>,km1,<:    k2=:>,k2,<:   km2=:>,km2,
          <:    k3=:>,k3,<:<10>k4=:>,k4,<:    k5=:>,k5,<:    k6=:>,k6,
          <:    k7=:>,k7,<:<10> j=:>,j,<:     a=:>,a,<:     h=:>,h,
          <:    dt=:>,dt,<:   eps=:>,eps,<:<10>tb=:>,tb,<:    te=:>,te, 
          <:<10> x=:>,X(1),<:     y=:>,X(2),
          <:     z=:>,X(3),<:     u=:>,X(4),<:     v=:>,X(5),<:<10><10>:>,
          <:   tid       h      HBrO2       Br-        Ce4:>,
          <:        HBrO     BrCH(COOH)2:>,<:<10>                       x:>,
          <:         y          z          u           v:>,
          <:<10><25>:>,false,3);
     end i;
     swoprec(bs,128);
     bs(124):= 0; bs(125):= date; bs(126):= clock;
     bs(127):= -1; bs(128):= 8;
     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),X(4),X(5));
        setposition(out,0,0);
     end;
     outrec(bs,8);
     bs(1):= s; bs(2):= t; bs(3):= h;
     for i:= 1 step 1 until 5 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(5,fjac,xin,xout);
     setposition(bs,0,0);
     swoprec(bs,128);
     bs(127):= ndata;
     close(bs,true);
end;
▶EOF◀