DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »gmb1proctx«

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

TextFile

;       gmb1_proc_tx          * page 1   27 09 77, 11.18;  

;  gmb1_proc

if listing.yes
char 10 12 10

gmb1_proc = set 1 disc

gmb1_proc = algol

external long procedure gmb1_proc
_________________________________
_        (c, e2, lat1, s, az1, lat2, dlng);  
value     c, e2, lat1, s, az1;  
long      c,     lat1, s, az1, lat2, dlng;  
real         e2;  

comment

the procedure performs the solution of the first
main problem using the gaussian mid-latitude formulas

gmb1_proc   (return)            long
the azimuth at station 2 towards station 1
as a geotype variable

c           (call)              long
radius equal to a*a/b in units of '-6 m, 
a semi major axis and b semi minor axis

e2          (call)              real
square of second eccentricity of ellipsoid

lat1        (call)              long
latitude of station 1 as a geotype variable

s           (call)              long
the distance between the stations in units of '-6

az1         (call)              long
the azimuth at station 1 towards station 2
as a geotype variable

lat2        (return)            long
latitude of station 2 as a geotype variable

dlng        (return)            long
the difference of longitude station 2 minus
station 1 as a geotype variable;  

begin

  real     S, C, ar, caz, saz, caz2, saz2, bd, 
  _        sinb, cosb, n2, V2, N, t, t2, dS, wr;  
  long     br1, lg1, am1, am, bm, br, lg, az, 
  _        dl, db, da;  
  integer  n;  

  br1:=lg1:=am1:=0;  
  S:=s*'-6;  
  C:=c*'-6;  

\f



comment gmb1_proc_tx          * page 2   27 09 77, 11.18
0 1 2 3 4 5 6 7 8 9 ;  

  for n:=1, n+1 while db > 5 and dl > 5 and da > 5 do
  begin

    am:=az1+am1//2;  
    ar:=am*rg;  
    caz:=cos(ar);  
    saz:=sin(ar);  

    caz2:=caz*caz;  
    saz2:=saz*saz;  
    bm:=lat1+br1//2;  
    bd:=bm*rg;  
    sinb:=sin(bd);  
    cosb:=cos(bd);  
    n2:=e2*cosb**2;  
    V2:=1+n2;  
    N:=C/sqrt(V2);  
    t:=sinb/cosb;  
    t2:=t*t;  
    wr:=S/N;  
    dS:=wr*wr/24;  
    br:=V2*wr*caz*(1+dS*(saz2*(3*t2+2*V2)
    _   +3*caz2*n2*(t2-V2-4*n2*t2)))/rg;  
    lg:=wr*saz/cosb*(1+dS*(saz2*t2
    _   -caz2*(V2-9*n2*t2)))/rg;  
    az:=wr*saz*(t+dS*t2*(caz2*(2+7*n2
    _   +9*n2*t2+5*n2*n2)+saz2*(2*V2+t2)))/rg;  
    db:=abs(br1-br);  
    dl:=abs(lg1-lg);  
    da:=abs(am1-az);  
    br1:=br;  
    lg1:=lg;  
    am1:=az;  
  end;  

  lat2:=lat1+br1;  
  dlng:=lg1;  
  gmb1_proc:=az1+am1+extend 1 shift 47;  

end;  

end

if warning.yes
(mode 0.yes
message gmb1_proc not ok
look up gmb1_proc)
▶EOF◀