DataMuseum.dk

top - metrics - download

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

└─⟦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

;       e_rad_tx              * page 1    2 11 77, 13.53;  

;  e_rad

if listing.yes
char 10 12 10

erad = set 1

erad = algol

external long procedure erad
____________________________
_       (a, f, mode, B);  
value    a, f, mode, B;  
long     a,          B;  
integer        mode;  
real        f;  

comment

The procedure performs computation of

radius of curvature in meridian          mode = 1

radius of curvature in prime vertical    mode = 2

radius of gaussian curvature             mode = 3

Formulas from Kønig/Weise
I.38, I.38b, I.40, I.40b, I.44, I.44b 

erad     (return)    long
the radius of curvature in units of '-6 m

a        (call)      long
semi-diameter in units of '-6 m

f        (call)      real
flattening

mode     (call)      integer

B        (call)      long
geodetic latitude as geotype variable;  

begin
  real     n1, n2, n3, n4, n5, argm;  
  array    m(0:5);  
  integer  q;  
  long     w, ab;  

  w:=a*f;  
  ab:=a-w;  
  ab:=(a+ab)//2;  
  n1:=f/(2-f);  
  n2:=n1*n1;  
  n3:=n2*n1;  
  n4:=n3*n1;  
  n5:=n4*n1;  
  argm:=B*rg;  

\f



comment e_rad_tx              * page 2    2 11 77, 13.53
0 1 2 3 4 5 6 7 8 9 ;  

  case mode of
  begin

    begin
      m(0):=n2/4+n4/64;  
      m(1):=-3*n1+3*n3/8+3*n5/64;  
      m(2):=15*n2/4-15*n4/16;  
      m(3):=-35*n3/8+175*n5/128;  
      m(4):=315*n4/64;  
      m(5):=-693*n5/128;  

    end;  

    begin
      m(0):=2*n1+5*n2/4+n3/2+25*n4/64+n5/32;  
      m(1):=-n1-2*n2-11*n3/8-3*n4/4-39*n5/64;  
      m(2):=3*n2/4+3*n3/2+17*n4/16+5*n5/64;  
      m(3):=-5*n3/8-5*n4/4-115*n5/128;  
      m(4):=35*n4/64+35*n5/32;  
      m(5):=-63*n5/128;  
    end;  

    begin
      m(0):=n1;  
      m(1):=-2*(n1+n2);  
      m(2):=2*(n2+n3);  
      m(3):=-2*(n3+n4);  
      m(4):=2*(n4+n5);  
      m(5):=-2*n5;  
    end;  

  end;  

  w:=ab*clenshaw(m, 5, 2*argm, 3);  
  erad:=ab+w;  

end;  

end

if warning.yes
(mode 0.yes
message e_rad not ok
lookup e_rad)

▶EOF◀