|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 25344 (0x6300)
Types: TextFile
Names: »readggobstx«
└─⟦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⟧
; geom geod input * page 1 13 12 77, 10.59;
; read_gg_obs
; ***********
if listing.yes
char 10 12 10
read_gg_obs = set 1
read_gg_obs = algol
external long procedure read_gg_obs
___________________________________
_ (in, reg_label, obs_rec, zdobs_rec, action_a, last_ST);
zone in;
array reg_label, obs_rec, zdobs_rec;
long array action_a;
long last_ST;
comment input of directions, laplaceaz, and distances.
______________________________________________________
read_gg_obs r(return value long) represented in 4 booleans:
_ obs_kind
_ obs_type
_ false add q <* = no_of_directions in horizont *>
_ false add (if no_of_z_dst = 0 then 0 else 4095)
obs_rec.nrf(0) contains in any case stnmb
obs_rec.identif contains in any case identification.
;
\f
comment geom geod input * page 2 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
_
comment
fixed fields in obs_rec
_______________________
byte nr type name content
2 integer obsrcl recordlength
4 integer - recordsum for in/outvar
5 boolean obskind 2=geom, 3=redgeom
_ 4=heights, 5=pot diff
6 boolean obstype for obskind=2 or 3:
_ 1=dir, 2=lapl, 3=dist,
_ for obskind=4:
_ 1=zdist, 2=heightdiff
_ for obskind=5:
_ 1=potdiff, 2=heightdiff
7 boolean q number of objects
8 boolean year year of observ,
_ 0=no info
9 boolean sets
10 boolean oc-state 0=not known
_ 1=known but not fixed
11 boolean tpd_obs typedec for obs
12 boolean tpd_oc typedec for oc/objh
16 long identif identification
20 long tapenr no. of tape
24 long oconst oc/instrh
28 real md m.e. of dir or rel. dist
32 real mc m.e. of centering
variable part of obs_rec
_________________________
hl := 32
hl+4 long nr(0) station number
hl+4(1+t) long nr(t) obj. number(t)
hl+4(1+q)+1+t boolean exc_bit(t) false add if exc 1
round upwards to even byte no.
hl+5(1+q)+4t long obs(t)
hl+5(1+q)+4q+4t long objh(t) objheight
with ub = hl+5(1+q)+4q (kind=2 or kind=3)
_ or hl+5(1+q)+8q (kind=4) we get
ub+1 boolean exc_dst_tpd
ub+2 boolean exc_dir_tpd
ub+2+4t long exc_dst(t)
ub+2+4r+4t long exc_dir(t)
total use of bytes:
_ kind=2 or 3 , r<>0 : 32+5(1+q)+4q+2+8r
_ kind=2 or 3 , r=0 : 32+5(1+q)+4q
_ kind=4 : 32+5(1+q)+8q;
\f
comment geom geod input * page 3 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
begin
comment datamatic variables;
___________________________
integer class, saved_class, state, action,
_ obs_rcl, new_oo, new_rr, new_hh,
_ exc_kind_1, exc_kind2, sum,
_ nrtp, dec1, dec2, dec3,
_ dir_count, dst_count, zdst_count,
_ h_diff_count, exc_count,
_ q, r, o, h, t, i;
integer array field int_f;
long array field hor_obs_f, exc_dst_f, exc_dir_f,
_ zdst_f, objh_f, long_f, nr_f;
real array field real_f;
boolean array field bool_f, exc_bits_f;
boolean field oc_state_f, oc_tpd_f;
long g1, g2, read_gg_obs_1;
boolean tpd1, tpd2, obs_tpd, zd_cm_tpd, status,
_ h_obs_type, z_dst_type, exc_type,
_ n_exc_bits, block_ok, c_term;
_
comment geodetic variables;
___________________________
boolean field exc_dst_tpd_f, exc_dir_tpd_f;
long array nr, hor_obs, zdst, obj_h,
_ exc_dst, exc_dir(0:40);
boolean array hor_obs_tpd, zdst_tpd, objh_tpd,
_ exc_dst_tpd, exc_dir_tpd,
_ exc_bits(0:40);
long stn, oconst, LAT, LNG;
real sets, mdir, mcdir, mdst, mcdst;
long tapenr, instrh, identif;
integer obskind, obstype, save_udt, year;
boolean oc_state, oc_tpd, laplace,
_ dir, instrh_tpd;
integer procedure max(i1, i2);
______________________________
value i1, i2;
integer i1, i2;
max := if i1 >= i2 then i1 else i2;
\f
comment geom geod input * page 4 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
long procedure rstn(nrtp, class);
_________________________________
integer nrtp, class;
begin long stn;
class := 0;
stn := read_stn(in, nrtp);
if t_char=97 or t_char=10 then class := 1
else
if t_char=99 then class := 2
else
if mtr then class := 3
else
if nrtp<=2 then class := 5;
if stn=-longone and t_char=97 then class := 7;
rstn := stn;
end rstn;
long procedure rstn_1(nrtp, class, last_stn);
_____________________________________________
value last_stn;
integer nrtp, class;
long last_stn;
begin long stn;
class := 0;
if last_stn > 0 then
begin
stn := last_stn;
nrtp := if last_stn < (200 00 0000 shift 19) then 1
_ else if last_stn > 0 then 2
_ else 5;
end
else
stn := read_stn(in, nrtp);
if t_char=97 or t_char=10 then class := 1
else
if t_char=99 then class := 2
else
if mtr then class := 3
else
if nrtp<=2 then class := 5;
if stn=-longone and t_char=97 then class := 7;
rstn_1 := stn;
end rstn_1;
long procedure read_geo_on_line(tpd, class);
____________________________________________
boolean tpd;
integer class;
begin
mtr := false; ; udt := 115;
if m_i_l(in, true) then
begin
read_geo_on_line := read_geo(in, tpd);
if mtr then class := 3
else class := 4;
end
else
begin
read_geo_on_line := 0; class := 6;
end;
end read_geo_on_line;
\f
comment geom geod input * page 5 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
comment decision table for obsinput
____________________________________
class 0 1 2 3 4 5 6 7
_ nil a c mtr dir space -, mil stp
nr state after
0 rstn 0 1 1 0 0 0 13 13
1 incl.head+rstn 13 12 12 8 13 3 13 13
2 rstn 13 12 12 8 13 3 13 12
3 incl.obj +rol 13 13 13 4 5 5 13 12
4 incl.dst +rol 13 13 13 11 13 10 2 13
5 zdst/dir +rol 13 13 13 10 6 6 6 13
6 incl.dir 13 13 13 13 7 7 2 13
7 zdst +rol 13 13 13 10 11 11 11 13
8 excdst +rol 13 13 13 13 9 9 13 13
9 incl.exc +rol 13 13 13 13 13 13 2 13
10 incl.zdst +rol 13 13 13 13 11 11 2 13
11 v keep cl 13 13 13 2 2 2 13 13
12 check keep cl 13 13 13 13 13 13 13 13
13 exit
nr action reading of
__ ____________________________________ ____________
0 _ st := read_stn stn
1 include head st := read_stn obj, exc, stp
2 _ st := read_gol stn, obj, exc
3 include obj (st) g1 := read_gol dst.dir.zdst
4 include dst (g1) g1 := read_gol v, skrdst
5 g1=zdst/dir g2 := read_gol objh, v
6 include dir g1 := g2, class kept
7 g1=zdst g2 := read_gol objh, vnorm
8 st=excdst g1 := read_gol excdir
9 include exc (st, g1) st := read_stn stn, obj, stp
10 include zdst(g1, g2) g1 := read_gol v
11 g1=v class kept
12 check horizon class kept
13 normalt exit
;
\f
comment geom geod input * page 6 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
_
comment init of variables and fixed field variables;
____________________________________________________
read_gg_obs_1 := 0;
mdir := reg_label(6);
mcdir := reg_label(7);
mdst := reg_label(8);
mcdst := reg_label(9);
tapenr := long reg_label(4);
obskind := reg_label(2) extract 12;
save_udt := udt;
udt := 115; <*sexages as standard*>
int_f := 0;
long_f := 12;
real_f := 24;
nr_f := 36;
bool_f := 4;
class := action := 0;
for state := action while state<13 do
begin
saved_class := class;
action := action_a(state) shift (6*(class-7)) extract 6;
\f
comment geom geod input * page 7 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
case action + 1 of
begin
begin comment action 0 : input of stnnr;
stn := rstn_1( nrtp, class, last_ST);
end action 0;
begin comment action 1 : include head and look for objnr;
q := r := h := o := 0;
dir_count := zdst_count := dst_count := exc_count :=
h_diff_count := 0;
nr(0) := stn;
exc_bits(0) := false;
c_term := t_char=99;
year := read_ident(in, tpd1);
t := tpd1 extract 12;
if year>1000 and t=0 then
begin
sets := read_ident(in, tpd1); t := tpd1 extract 12;
end
else
begin sets := year; year := 0; end;
for t := t step -1 until 1 do sets := sets/10.0;
identif := read_ident(in, tpd1);
if t_char=109 then
begin comment instrh;
instrh := identif;
instrh_tpd := false add (10 shift 6)
_ add (tpd1 extract 6);
identif := read_ident(in, tpd1);
end
else
instrh := -10000000;
if m_i_l(in, t_char<>98 and t_char<>108 ) then
begin comment read oc or laplace lat and long;
laplace := t_char=98 or t_char=108;
o_const := read_geo(in, oc_tpd);
oc_state := false add 1;
if laplace then
begin
LAT := o_const;
o_const := 0;
LNG := read_geo(in, oc_tpd);
oc_state := false add 10;
end;
end oc or laplace
else
begin
o_const := 0;
oc_state :=
oc_tpd :=
laplace := false;
end;
dir := -, laplace;
stn := rstn( nrtp, class);
end action 1;
\f
comment geom geod input * page 8 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
begin comment action 2 : look for new objnr;
stn := rstn( nrtp, class);
end action 2;
begin comment action 3 : include objnr and look for obs;
q := q+1;
exc_bits(q) := false;
nr(q) := stn;
g1 := read_geo_on_line(tpd1, class);
end action 3;
begin comment action 4:include dist or h_diff, look for v;
if obs_kind = 2 or obs_kind = 3 then
begin
dst_count := dst_count+1;
hor_obs(q) := g1;
hor_obs_tpd(q) := tpd1;
exc_bits(q) := exc_bits(q) or ((false add 1) shift 1);
g1 := read_geo_on_line(tpd1, class);
comment evt content of g1 can be v or skrdist;
end
else
if obs_kind = 4 or obs_kind = 5 then
begin
h_diff_count := h_diff_count + 1;
z_dst(q) := g1;
z_dst_tpd(q) := tpd1;
obj_h(q) := read_geo_on_line(tpd1, class);
obj_h_tpd(q) := tpd1;
exc_bits(q) := exc_bits(q) or (false add 1 shift 2);
g1 := read_geo_on_line(tpd1, class);
end;
end action 4;
begin comment action 5 : content of g1 can be a horisontal
direction or a zenithdistance, look for evt obj-height;
g2 := read_geo_on_line(tpd2, class);
end action 5;
begin comment action 6 : include direction, g1 := g2,
class kept;
dir_count := dir_count+1;
hor_obs(q) := g1;
horobs_tpd(q) := tpd1;
exc_bits(q) := exc_bits(q) or ((false add 1) shift 1);
g1 := g2;
tpd1 := tpd2;
end action 6;
begin comment action 7 : the content of g1 can be zenithdist
or v , look for objheight (mtr-type);
g2 := read_geo_on_line(tpd2, class);
end action 7;
begin comment action 8 : the content of stn is of mtr-type
and might be an exc-dist, look for exc-dir;
g1 := read_geo_on_line(tpd1, class)
end action 8;
\f
comment geom geod input * page 9 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
begin comment action 9 : include the elements of excentricity,
look for more in line;
exc_bits(q) := exc_bits(q) or (false add 1);
exc_dst(q) := stn;
exc_dir(q) := g1;
exc_dst_tpd(q) := false
add ((nrtp extract 12)+(2 shift 6));
exc_dir_tpd(q) := tpd1;
g1 := read_geo_on_line(tpd1, class);
end action 9;
begin comment action 10 : include zdist and objectheight,
look for further information on the line;
zdst_count := zdst_count+1;
exc_bits(q) := exc_bits(q) or ((false add 1) shift 2);
zdst(q) := g1;
zdst_tpd(q) := tpd1;
objh(q) := g2;
objh_tpd(q) := tpd2;
g1 := read_geo_on_line(tpd1, class);
end action 10;
begin comment action 11 :the contg.. content of g1 might be
v . this is a dummy block, the class is kept;
end action 11;
\f
comment geom geod input * page 10 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
begin comment action 12 : reading of a round
has been terminated.
The information is transferred to the obs.zone
;
comment save last read nmb for next input;
last_ST := stn;
block_ok := (dst_count>0 and dir_count=0)
_ or (dst_count=0 and dir_count>0)
_ or (dst_count=0 and z_dst_count>0)
_ or (h_diff_count > 0 and
_ dir_count + dst_count + z_dst_count = 0);
if -, block_ok then
begin
write(out, nl, 4,
<:horisont ej accepteret:>, nl, 1,
false add 42, 22, nl, 2,
<:jnsd: :>, <<ddd ddd dd d>, identif);
end;
obs_rec.long_f(1) := identif;
obs_rec.nr_f(0) := nr(0);
_
comment output of horizontal obs;
_________________________________
if (dst_count>0 or dir_count>0) and block_ok then
begin
if laplace then
begin
q := q + 2;
nr(q-1) :=
nr(q) := nr(0);
hor_obs(q-1) := LNG;
hor_obs(q) := LAT;
hor_obs_tpd(q-1) :=
hor_obs_tpd(q) := hor_obs_tpd(1);
exc_bits(q-1) :=
exc_bits(q) := false add (1 shift 1);
end;
\f
comment geom geod input * page 11 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
o := h := r := dec1 := dec2 := dec3 := 0;
for t := 0 step 1 until q do
begin
status := exc_bits(t);
h_obs_type := t>0 and (status shift (-1));
exc_type := status;
if (t=0 or h_obs_type) and exc_type then r := r+1;
if h_obs_type then o := o+1;
end count;
exc_bits_f := 32+4*(o+1)+1;
obsrcl := 32+5*(1+o);
obsrcl := ((obsrcl+1)//2)*2;
hor_obs_f := obsrcl;
obsrcl := obsrcl+4*o;
if r>0 then
begin comment exc;
exc_dst_tpd_f := obsrcl+1;
exc_dir_tpd_f := obsrcl+2;
exc_dst_f := obsrcl+2;
exc_dir_f := obsrcl+2+4*r;
obsrcl := obsrcl+2+8*r;
end;
new_oo := new_rr := 0;
for t := 0 step 1 until q do
begin
status := exc_bits(t);
n_exc_bits := false;
h_obs_type := t>0 and (status shift (-1));
z_dst_type := t>0 and (status shift (-2));
exc_type := status;
if (t=0 or h_obs_type) and exc_type then
begin
new_rr := new_rr+1;
n_exc_bits := n_exc_bits or (false add 1);
obs_rec.exc_dst_f(new_rr) := exc_dst(t);
obs_rec.exc_dir_f(new_rr) := exc_dir(t);
dec1 := max(dec1, exc_dst_tpd(t) extract (6));
dec2 := max(dec2, exc_dir_tpd(t) extract (6));
if new_rr=1 then
begin
exc_kind1 :=
exc_dst_tpd(t) shift (-6) extract (6);
exc_kind2 :=
exc_dir_tpd(t) shift (-6) extract (6);
end;
end;
\f
comment geom geod input * page 12 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
if h_obs_type then
begin
new_oo := new_oo+1;
obs_rec.nr_f(new_oo) := nr(t);
obs_rec.hor_obs_f(new_oo) := hor_obs(t);
dec3 := max(dec3, hor_obs_tpd(t) extract (6));
obstpd:= hor_obs_tpd(t);
n_exc_bits := n_exc_bits or (false add 1 shift 1);
end;
if h_obs_type or t=0 then
obs_rec.exc_bits_f(new_oo) := n_exc_bits;
end;
obstpd := (obstpd shift(-6)) shift 6 add dec3;
if r>0 then
begin
obs_rec.exc_dst_tpd_f :=
((false add exc_kind1) shift 6) add dec1;
obs_rec.exc_dir_tpd_f :=
((false add exc_kind2) shift 6) add dec2;
end;
for t := 2 step -1 until 1 do
obs_rec.int_f(t) := case t of
( obsrcl, 3);
obstype := if dst_count>0 then 3
_ else if laplace then 2 else 1;
for t := 5 step -1 until 1 do
obs_rec.bool_f(t) := false add (case t of
( obskind, obstype, o, year, round(sets)));
obs_rec.bool_f(6) := oc_state;
obs_rec.bool_f(7) := obs_tpd;
obs_rec.bool_f(8) := oc_tpd;
obs_rec.long_f(2) := tapenr;
obs_rec.long_f(3) := oconst;
for t := 1 step 1 until 2 do
obs_rec.real_f(t) := case t of (
reg_label(if dir_count > 0 then 6 else 8),
reg_label(if dir_count > 0 then 7 else 9));
sum := 0;
for t := obsrcl//2 step -1 until 1 do
sum := obs_rec.intf(t)+sum;
obs_rec.intf(2) := -sum;
read_gg_obs_1 :=
((obs_rec.long_f(-1) shift (-12)) shift 12);
end output of horizontal obs;
\f
comment geom geod input * page 13 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
_
comment output of zd or hdiff;
_____________________________
if block_ok and (z_dst_count > 0 or h_diff_count > 0) then
begin
o := h := r := dec1 := dec2 := dec3 := 0;
for t := 0 step 1 until q do
begin
status := exc_bits(t);
h_obs_type := t>0 and (status shift (-1));
z_dst_type := t>0 and (status shift (-2));
exc_type := status;
if (t=0 or h_obs_type) and exc_type then r := r+1;
if h_obs_type then o := o+1;
if z_dst_type then h := h+1;
end count;
nr_f := 32+4;
exc_bits_f := 32+4*(h+1)+1;
obsrcl := 32+5*(1+h);
obsrcl := ((obsrcl+1)//2)*2;
z_dst_f := obsrcl;
obj_h_f := obsrcl+4*h;
obsrcl := obsrcl+8*h;
zd_obs_rec.nr_f(0) := nr(0);
new_hh := 0;
for t := 0 step 1 until q do
begin
status := exc_bits(t);
n_exc_bits := false;
h_obs_type := t>0 and (status shift (-1));
z_dst_type := t>0 and (status shift (-2));
exc_type := status;
if z_dst_type then
begin
zd_cm_tpd := (z_dst_tpd(t) shift (-6)) shift 6;
new_hh := new_hh+1;
zd_obs_rec.nr_f(new_hh) := nr(t);
zd_obs_rec.z_dst_f(new_hh) := z_dst(t);
dec1 := max(dec1, z_dst_tpd(t) extract (6));
zd_obs_rec.obj_h_f(new_hh) := objh(t);
dec2 := max(dec2, objh_tpd(t) extract (6));
n_exc_bits := n_excbits or (false add 1 shift 2);
end;
if z_dst_type or t=0 then
zd_obs_rec.exc_bits_f(new_hh) := n_exc_bits;
end;
\f
comment geom geod input * page 14 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
obs_tpd := zd_cm_tpd add dec1;
objh_tpd(0) := (false add 10) shift 6 add dec2;
if h_diff_count > 0 then
begin
obs_tpd := false add ((10 shift 6) + (obs_tpd extract 6));
objh_tpd(0) := false add ((9 shift 6)
_ + (objh_tpd(0) extract 6));
end;
if obs_kind = 2 or obs_kind = 3 then
obs_kind := 4;
obs_type := if z_dst_count > 0 then 1
_ else 2;
for t := 2 step -1 until 1 do
zd_obs_rec.int_f(t) := case t of
( obsrcl, 3);
for t := 5 step -1 until 1 do
zd_obs_rec.bool_f(t) := false add (case t of
( obskind, obstype, h, year, round(sets)));
zd_obs_rec.bool_f(6) := instrh_tpd; ;
zd_obs_rec.bool_f(7) := obs_tpd;
zd_obs_rec.bool_f(8) := objh_tpd(0);
for t := 3 step -1 until 1 do
zd_obs_rec.long_f(t) := case t of
(identif, tapenr, instrh);
i := 4 - obs_kind + obs_type;
comment gris;
for t := 1 step 1 until 2 do
zd_obs_rec.real_f(t) := case t of
(case i of (reg_label(6), reg_label(8)),
_case i of (reg_label(7), reg_label(9)));
sum := 0;
for t := obsrcl//2 step -1 until 1 do
sum := zd_obs_rec.intf(t)+sum;
zd_obs_rec.intf(2) := -sum;
read_gg_obs_1 := read_gg_obs_1 + 4095;
end output of zenith-distances;
end action 12;
\f
comment geom geod input * page 15 13 12 77, 10.59
0 1 2 3 4 5 6 7 8 9 ;
begin comment action 13: no_action/alarm;
last_ST := stn;
if t_char <> 97 and t_char <> 99 and
_ t_char <> 10 and t_char <> 13 then
begin
write(out, <:<10>:>,
<:<10>input-data ej ok, fejl ved::>,
<:<10>:>, false add 42, 28,
<:<10>:>, <:last jnsd:>, <<dd ddd dd d>, identif,
<:<10>:>, <:state :>, <<ddd>, state,
<:<10>:>, <:class :>, <<ddd>, class,
<:<10>:>, <:sav_class:>, saved_class, <:<10>:>,
<:<10>:>, <:tchar :>, <<ddd>, t_char);
end alarm;
end action 13;
end action cases;
end state-loop;
udt := save_udt;
read_gg_obs := read_gg_obs_1;
if c_term then read_gg_obs := 0;
end read_gg_obs;
end
if warning.yes
(mode 0.yes
message read_gg_obs not ok
lookup read_gg_obs)
end
▶EOF◀