DataMuseum.dk

top - metrics - download

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

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

TextFile

; write_neq_tx       * page  ;
 
; write_neq
; *********
 
if listing.yes
char nl ff nl
 
 
writeneq=set 1
 
writeneq=algol 
 
external procedure writeneq(outz,neq);
______________________________________
zone                        outz;
array                             neq;
begin
integer col,sz, t,i,frst_col, last_col,lc;
integer field frst_col_f, last_col_f, sing_f, block_f, dspl,
fnc_gr_f;
integer array field   cat_i1_f, cat_sz_f;
array         field   status_f;
boolean reduced, fnc;
  
block_f := 6;
sing_f  := 8;
dspl     := 10;
fnc_gr_f := 12;
frst_col_f := 14;
last_col_f := 16;
  
 
dspl     := neq.dspl//4;
fnc      := neq.fnc_gr_f > 0;
frst_col := neq.frst_col_f;
last_col := neq.last_col_f;
  
write(outz, ff,1,nl,2,<:normalligninger:>,nl,1,
<<  -dddd>, <:blocknr:>, neq.block_f,nl,1);
reduced := neq.sing_f >= 0;
if reduced then
write(outz,<:reduceret med :>, neq.sing_f, <:_singulariteter:>,
nl,1);
 
cat_i1_f := 16 - 2*(frst_col - 1);
cat_sz_f := cat_i1_f + 2*(last_col - frst_col + 1);
status_f := cat_sz_f + 2*(last_col - 2*frst_col + 2);
 
for col := frst_col step 1 until last_col do
begin
lc := 0;
sz := neq.cat_sz_f(col);
write(outz, nl,2, <:col nr:>, col,
<:_sparede nuller:>, sz,nl,1);

i := neq.cat_i1_f(col)//4;
for t := sz + 1 step 1 until col do
begin
write(out_z,nl,1,<:(:>,<<-dddd>,t,<:):>,sp,3);
if reduced or fnc then
 write(out_z,<<-d.ddd ddd ddd'-ddd>,neq(t+i))
else write_double(outz,neq(t+i),neq(t+i+dspl));
end t-loop;
 
end col-loop;
write(outz,nl,2);
end writeneq;
 
end
 
if warning.yes
(mode 0.yes
message write_neq not ok
lookup write_neq)
 
end
 

▶EOF◀