DataMuseum.dk

top - metrics - download

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

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

TextFile

begin
  integer array n (0:19, 0:3),
                n1 (0:19);
  real array    f1, h1, vægt1, vægt2, f2, h2 (0:19, 0:19),
                z2, sigma2 (0:19, 0:3, 0:19),
                gamma, ny_gamma (0:19),
                pi, ny_pi (0:19);
  zone          skadetypefil, udfil (128, 1, stderror);
  integer       t, k, j, tau,
                faktisk_tt, tt,
                iterationsnr, t_faktor, maxinterval,
                maxnr, i, skip_faktor,
                vægttype1, vægttype2, d_form, g_form,
                t1, k1, j1, j_faktor, q_faktor,
                ordre;
  real          kvartalsinformation, mindste_varians, epsilon, delta, q1,
                ny_q1, en, tællersum, nævnersum, tal, tal1, tal2, tal3;
  boolean       g_kriterium, reserveberegning,
                fast_b, estimat_udskrivning, parametre_indlæst, fejl;
\f

  procedure inddatafejl (a);
  string                 a;
  begin
    write(out, <:<10>fejl ved indlæsning af :>, a);
    goto halt
  end;

  integer procedure mindste (i, j);
  integer                    i, j;
  mindste:= if i<j then i else j;

  integer procedure største (i, j);
  integer                    i, j;
  største:= if i>j then i else j;

  real procedure psi (t, j);
  integer             t, j);
  psi:= if reserveberegning and faktisk_tt<tt then 1
        else if j<>tt-t then 1 else 0.5;

  real procedure sum (t, n, ø, f);
  value               t;
  integer             t, n, ø;
  real procedure               f;
  begin
    real res;
    res:= 0;
    for t:= n step 1 until ø do res:= res+f;
    sum:= res
  end sum;

  real procedure sum1 (t, n, ø, s, f, g);
  value                t;
  integer              t, n, ø, s;
  real procedure                   f, g;
  begin
    real res, tal;
    t:= n; res:= 0;
    while t<ø do
    begin
      tal:= g;
      if tal<>0 then res:= res+f/tal;
      t:= t+s
    end;
    sum1:= res
  end sum1;

  procedure tidspunkt;
  begin
    real time, r;
    systime(1, 0, time);
    write (out, "nl", 1, "sp", 40, <<dd dd dd>, systime (4, time, r),
                <: kl. :>, <<dd dd>, r/100)
  end tidspunkt;
\f

  procedure skriv_abd_og_gamma;
  begin
    integer i;
    real head;

    head:= real <: j    a(j)         tau  b(tau)          t    d(t):>;
    write (out, "nl", 1, string head, "nl", 1);
    for i:= 0, 1, 2, 3, 4 step 1 until faktisk_tt do
    write (out, "nl", 1, << d>, i  , << ddddd.ddd>, ny_a(i),
                "sp", 7, << d>, i+1, << ddddd.ddd>, ny_b(i+1),
                "sp", 7, << d>, i  , << ddddd.ddd>, ny_d(i));
    write (out, "nl", 7, <:samme vektorer normeret:>, "nl", 3,
                string head, "nl", 1);
    for i:= 0, 1, 2, 3, 4 step 1 until faktisk_tt do
    write (out, "nl", 1, << d>, i  , << ddddd.ddd>, ny_a(i)/ny_a(0),
                "sp", 7, << d>, i+1, << ddddd.ddd>, ny_b(i+1)/ny_b(1),
                "sp", 7, << d>, i  , << ddddd.ddd>, ny_d(i)/ny_d(0),
                "sp", 7, << d>, i  , << ddddd.ddd>,
                ny_b(i+1)*ny_d(i)/ny_b(1)/ny_d(0));
    write (out, "nl", 3);
    if g_form=2 then
    begin
      write (out, <:<10> T   Gamma(t)<10>:>);
      for i:= 0 step 1 until mindste (tt, 3) do
      write (out, "nl", 1, << d>, i, << ddddd.ddd>, ny_gamma(i))
    end g_form=2
  end skriv_abd_og_gamma;

  boolean procedure slutkriterium;
  begin
    integer i;
    boolean b;

    b:= true;
    for i:= 0 step 1 until faktisk_tt do
    b:= b and abs (ny_a(i) - a(i)) < epsilon
          and abs (ny_b(i+1) - b(i+1)) < epsilon
          and abs (ny_d(i) - d(i)) < epsilon;
    for i:= 0 step 1 until tt do
    b:= b and abs (ny_gamma(i) - gamma(i)) < epsilon
          and abs (ny_pi(i) - pi(i)) < epsilon;
    slutkriterium:= b or iterationsnr >= maxnr
                      or (q_kriterium and abs (ny_q1 - q1) < delta)
  end slutkriterium;
▶EOF◀