|
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: 2304 (0x900)
Types: TextFile
Names: »setgaussctx«
└─⟦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⟧
; proj proc * page 1 27 11 77, 20.34;
; set_gauss_crv
; *************
if listing.yes
char 10 12 10
set_gauss_crv = set 1
set_gauss_crv = algol
external real procedure set_gauss_crv
_____________________________________
_ (reg_lab, k_a);
array reg_lab, k_a;
begin
array argm(-1:8);
integer t;
real mer_arc;
long a0_m;
t := reg_lab(2) extract 12;
if t = 2 <*geo*> then
begin
set_gauss_crv :=
k_a(-1) := (extend 1) shift 46;
k_a(-2) := 8;
chebychef_c(3, t, k_a(-2), argm(t),
_ 0.5/(e_rad(long reg_lab(6), reg_lab(7), 3,
_ r_t_geo(pi*(0.25 + 0.25*argm(t)),
_ false add (1 shift 6))))**2, k_a(t));
end
else
if t = 3 or t = 4 or t = 12 then
<* itm utm sb *>
begin
comment scale of half major axis;
a0_m := (long reg_lab(6))*reg_lab(8);
a0_m := long reg_lab(6) - a0_m;
set_gauss_crv :=
k_a(-1) :=
mer_arc := m_arc(a0_m, reg_lab(7), 1,
_ (extend 1) shift 46 <*90 dg*>);
k_a(-2) := 6;
chebychef_c(3, t, k_a(-2), argm(t),
_ 0.5/(e_rad(a0_m, reg_lab(7), 3,
_ m_arc(a0_m, reg_lab(7), 2,
_ r_t_geo(0.5'-6*(argm(t)+1)*mer_arc, false add 512))))**2,
_ k_a(t));
end
else
system(9)alarm:(t, <:<10>ill. setgc:>);
end set_gauss_crv;
end
if warning.yes
(mode 0.yes
message set_gauss_crv not ok
lookup set_gauss_crv)
▶EOF◀