|
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: 12288 (0x3000)
Types: TextFile
Names: »readasobstx«
└─⟦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⟧
; astro satellite input * page 1 6 06 79, 15.28;
; read_as_obs
; ***********
if listing.yes
char 10 12 10
read_as_obs = set 1
read_as_obs = algol
external long procedure read_as_obs
___________________________________
_ (in, reg_label, obs_rec, last_ST);
zone in;
array reg_label, obs_rec;
long last_ST;
comment input of directions, laplaceaz, and distances.
______________________________________________________
read_as_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 astro satellite input * page 2 6 06 79, 15.28
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
boolean obskind 16
6 boolean obstype for obskind=16:
1=vinkeldif=70, 2=vinkeldif=0,
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=1sx m.e. of dir or rel. dist
32 real mc=0 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 astro satellite input * page 3 6 06 79, 15.28
0 1 2 3 4 5 6 7 8 9 ;
begin
comment datamatic variables;
___________________________
integer t, t1, nr_tp;
long pf_char;
integer field lng_f;
long array field nr_f;
real field weight;
real field me1, me2;
real field sets_f;
long field ident_f;
long array field obs;
long field y1, y2, z1, z2, w_f;
long field Bz, Lz;
long read_as_obs_1;
boolean v_tpd, tpd,tpd1, PF1, PF2;
_
comment geodetic variables;
___________________________
boolean field tpd_f, obs_kind_f, obs_type_f,
_ obs_count_f, PF_state_f, w_state_f;
boolean array field pff;
long st1, st2, bz, lz, w;
long array obs_a(1:80);
boolean array pf_byte(1:80);
integer max_dec;
real field tobs;
real sets, mdir, mcdir, mdst, mcdst, obs_r;
long tapenr, instrh, identif;
integer obs_count, obskind, obstype, save_udt;
\f
comment astro satellite input * page 4 6 06 79, 15.28
0 1 2 3 4 5 6 7 8 9 ;
long procedure read_star(in, nr_tp, pf);
________________________________________
zone in;
integer nr_tp;
boolean pf;
begin
integer pf_char;
long st;
st := read_stn(in, nr_tp);
if st <> 200 00 0000 shift 19 and st > 0 then
begin
pf_char := (st shift (-12)) extract 7;
if pf_char = 80 <*P*> or pf_char = 70 <*F*> then
begin
t_char := pf_char;
st := st - (pf_char shift 12);
end;
pf := t_char =112 <*p*> or t_char = 80 <*P*>;
if -, pf and t_char <> 102 <*f*> and t_char <> 79 <*F*> then
nr_tp := 5;
end;
read_star := st;
end read_star;
\f
comment astro satellite input * page 5 6 06 79, 15.28
0 1 2 3 4 5 6 7 8 9 ;
_
comment init of variables and fixed field variables;
____________________________________________________
read_as_obs_1 := 0;
mdir := reg_label(6);
mcdir := reg_label(7);
tapenr := long reg_label(4);
obskind := reg_label(2) extract 12;
save_udt := udt;
udt := 115; <*sexages as standard*>
lng_f := 2;
obs_kind_f := 5;
obs_type_f := 6;
obs_count_f := 7;
PF_state_f := 8;
w_state_f := 10;
tpd_f := 11;
ident_f := 16;
sets_f :=
tobs := 20;
w_f :=
weight := 24;
me1 := 28;
me2 := 32;
nr_f := 36;
y1 := 44;
y2 := 48;
z1 := 52;
z2 := 56;
Bz := 60;
Lz := 64;
comment
obsid, tobs, vægt, Bz, Lz,
st1, P, F, y1, z1,
st2, P, F, y2, z2,
identification;
last_ST :=
st1 := read_ident(in, tpd);
if st1<>-1 then
begin
if fp_mode(5) then write(out, nl, 3, st1);
read_as_obs_1 := 1;
obs_type := if t_char = 100 <*d*> or t_char = 68 <*D*> then 1
_ else if t_char = 103 <*g*> or t_char = 71 <*G*> then 2
_ else 3;
\f
comment astro satellite input * page 6 6 06 79, 15.28
0 1 2 3 4 5 6 7 8 9 ;
case obs_type of
begin
comment case 1, instantaneous directions;
begin
max_dec := 0;
obs_count := 0;
obs_rec.ident_f := st1;
read(in, obs_rec.t_obs);
bz := read_geo(in, tpd);
lz := read_geo(in, tpd);
if mil(in, true) then
begin
obs_rec.w_f := read_geo(in, tpd);
obs_rec.w_state_f := false add 1;
end
else
begin
obs_rec.w_f := 0;
obs_rec.w_state_f := false;
end;
t1 := 0;
for st1 := read_star(in, nr_tp, PF1)
_ while st1 <> (200 00 0000) shift 19
_ and st1 > 0 do
begin
obs_count := obs_count + 1;
obs_rec.nr_f(obs_count) := st1;
pf_byte(obs_count) := PF1;
t1 := t1 + 1;
obs_a(t1) := read_geo(in, tpd);
t1 := t1 + 1;
obs_a(t1) := read_geo(in,tpd1);
if tpd extract 6 > max_dec then
max_dec := tpd extract 6;
end input loop;
_
comment save obs and PF;
________________________
obs := nr_f + 4*obs_count;
pff := obs + 8*obs_count + 8;
t1 := 0;
for t := 1 step 1 until obs_count do
begin
t1 := t1 + 1;
obs_rec.obs(t1) := obs_a(t1);
t1 := t1 + 1;
obs_rec.obs(t1) := obs_a(t1);
obs_rec.pff(t) := pf_byte(t);
end;
obs_rec.obs(2*obs_count+1) := bz;
obs_rec.obs(2*obs_count+2) := lz;
obs_rec.lng_f := nr_f + ((13*obs_count+1)//2)*2 + 8;
obs_rec.tpd_f := false add (1 shift 6 + max_dec);
obs_rec.me1 := '-6*m_dir;
obs_rec.me2 := '-6*m_dir*mc_dir;
write(out,nl,2,obs_rec.ident_f,nl,1);
t1 := 0;
v_tpd := false add(1 shift 6 + 4);
for t := 1 step 1 until obs_count do
begin
write(out, nl,1);
write_stn(out,long obs_rec(9+t));
write(out,sp,2);
t1 := t1 + 1;
write_geo_c(out,long obs_rec(2*t-1+9+obs_count), v_tpd);
write(out,sp,2);
t1 := t1 + 1;
write_geo_c(out, long obs_rec(2*t+9+obs_count),vtpd);
end;
write(out,nl,1);
write_geo_c(out,long obs_rec(9+3*obs_count+1),vtpd);
write_geo_c(out,long obs_rec(9+3*obs_count+2),vtpd);
write(out,nl,2);
end case 1;
comment * page ;
comment case 2, anomaly groups, pt no action; ;
comment case 3, instantaneous angles, crab;
___________________________________________
begin
for t := 1 step 1 until 16 do
obs_rec(t) := real <::>;
obs_rec.ident_f := st1;
obs_rec.lng_f := 64;
read(in, obs_rec.tobs, obs_rec.weight);
if fp_mode(5) then write(out, << -d.ddddd>,
obs_rec.tobs, obs_rec.weight);
read(in, obs_r);
if fp_mode(5) then
write(out, <<___-.ddddddd>, obs_r);
obs_rec.Bz := obs_r/rg;
if fp_mode(5) then
write(out, <<___-.ddddddd>, obs_r);
read(in, obs_r);
obs_rec.Lz := obs_r/rg;
\f
comment astro satellite input * page 7 6 06 79, 15.28
0 1 2 3 4 5 6 7 8 9 ;
repeat_char(in);
st1 := read_stn(in, nrtp);
pf_char := (st1 shift (-12)) extract 7;
if pf_char = 80 <*P*> or pf_char = 70 <*F*> then
begin
t_char := pf_char;
st1 := st1 - (pf_char shift 12);
end;
PF1 := t_char = 112 <*p*> or t_char = 80 <*P*>;
obs_rec.PF_state_f := false add (PF1 extract 1);
if -, PF1 and t_char <> 102 <*f*> and t_char <> 70 <*F*> then
read_as_obs_1 := 0;
if fp_mode(5) then write(out, nl, 1);
if fp_mode(5) then write_stn(out, st1);
if fp_mode(5) then
write(out, sp, 1, if PF1 then <:p:> else <:f:>);
read(in, obs_r);
if fp_mode(5) then
write(out, <<___-dddddd.ddd>, obs_r);
obs_rec.y1 := obs_r/rg/rho;
read(in, obs_r);
if fp_mode(5) then
write(out, <<___-dddddd.ddd>, obs_r);
obs_rec.z1 := obs_r/rg/rho;
repeat_char(in);
st2:=read_stn(in, nrtp);
pf_char := (st2 shift (-12)) extract 7;
if pf_char = 80 <*P*> or pf_char = 70 <*F*> then
begin
t_char := pf_char;
st2 := st2 - (pf_char shift 12);
end;
PF2 := t_char = 112 <*p*> or t_char = 80 <*P*>;
obs_rec.PF_state_f := obs_rec.PF_state_f
_ add ((PF2 extract 1) shift 1);
if -, PF2 and t_char <> 102 <*f*> and t_char <> 70 <*F*> then
read_as_obs_1 := 0;
if fp_mode(5) then
begin
write(out, nl, 1);
write_stn(out, st2);
write(out, sp, 1, if PF2 then <:p:> else <:f:>);
end;
obsrec.tpd_f:= false add (1 shift 6 + 3);
read(in, obs_r);
if fp_mode(5) then
write(out, <<___-dddddd.ddd>, obs_r);
obsrec.y2:= obs_r/rg/rho;
read(in, obs_r);
if fp_mode(5) then
write(out, <<___-dddddd.ddd>, obs_r);
obs_rec.z2 := obs_r/rg/rho;
obs_rec.me_1 := '-6*m_dir;
obs_rec.me_2 := '-6*mc_dir;
obs_rec.nr_f(0) := st1;
obs_rec.nr_f(1) := st2;
obs_count := 1;
end case 3;
end obs_type-cases;
comment * page ;
obs_rec.obs_kind_f := false add obs_kind;
obs_rec.obs_type_f := false add obs_type;
obs_rec.obs_count_f := false add obs_count; ;
end;
udt := save_udt;
read_as_obs := read_as_obs_1;
end read_as_obs;
end
if warning.yes
(mode 0.yes
message read_as_obs not ok
lookup read_as_obs)
end
▶EOF◀