1*37da2899SCharles.Forsythimplement Geodesy; 2*37da2899SCharles.Forsyth 3*37da2899SCharles.Forsythinclude "sys.m"; 4*37da2899SCharles.Forsyth sys: Sys; 5*37da2899SCharles.Forsythinclude "math.m"; 6*37da2899SCharles.Forsyth maths: Math; 7*37da2899SCharles.Forsyth Pi: import Math; 8*37da2899SCharles.Forsyth sin, cos, tan, asin, acos, atan, atan2, sqrt, fabs: import maths; 9*37da2899SCharles.Forsythinclude "math/geodesy.m"; 10*37da2899SCharles.Forsyth 11*37da2899SCharles.ForsythApprox: con 0; 12*37da2899SCharles.Forsyth 13*37da2899SCharles.ForsythEpsilon: con 0.000001; 14*37da2899SCharles.ForsythMperft: con 0.3048; 15*37da2899SCharles.ForsythEarthrad: con 10800.0/Pi*6076.115*Mperft; # in feet (about 4000 miles) : now metres 16*37da2899SCharles.ForsythΔt: con 16.0; # now-1989 17*37da2899SCharles.Forsyth 18*37da2899SCharles.Forsyth# lalo0: con "53:57:45N 01:04:55W"; 19*37da2899SCharles.Forsyth# os0: con "SE6022552235"; 20*37da2899SCharles.Forsyth 21*37da2899SCharles.Forsyth# ellipsoids 22*37da2899SCharles.ForsythAiry1830, Airy1830m, Int1924, GRS80: con iota; 23*37da2899SCharles.Forsyth 24*37da2899SCharles.ForsythNgrid: con 100000; # in metres 25*37da2899SCharles.Forsyth 26*37da2899SCharles.ForsythVector: adt{ 27*37da2899SCharles.Forsyth x, y, z: real; 28*37da2899SCharles.Forsyth}; 29*37da2899SCharles.Forsyth 30*37da2899SCharles.ForsythLatlong: adt{ 31*37da2899SCharles.Forsyth la: real; # -Pi to Pi 32*37da2899SCharles.Forsyth lo: real; # -Pi to Pi 33*37da2899SCharles.Forsyth x: real; 34*37da2899SCharles.Forsyth y: real; 35*37da2899SCharles.Forsyth}; 36*37da2899SCharles.Forsyth 37*37da2899SCharles.ForsythEllipsoid: adt{ 38*37da2899SCharles.Forsyth name: string; 39*37da2899SCharles.Forsyth a: real; 40*37da2899SCharles.Forsyth b: real; 41*37da2899SCharles.Forsyth}; 42*37da2899SCharles.Forsyth 43*37da2899SCharles.ForsythDatum: adt{ 44*37da2899SCharles.Forsyth name: string; 45*37da2899SCharles.Forsyth e: int; 46*37da2899SCharles.Forsyth # X, Y, Z axes etc 47*37da2899SCharles.Forsyth}; 48*37da2899SCharles.Forsyth 49*37da2899SCharles.ForsythMercator: adt{ 50*37da2899SCharles.Forsyth name: string; 51*37da2899SCharles.Forsyth F0: real; 52*37da2899SCharles.Forsyth φ0λ0: string; 53*37da2899SCharles.Forsyth E0: real; 54*37da2899SCharles.Forsyth N0: real; 55*37da2899SCharles.Forsyth e: int; 56*37da2899SCharles.Forsyth}; 57*37da2899SCharles.Forsyth 58*37da2899SCharles.ForsythHelmert: adt{ 59*37da2899SCharles.Forsyth tx, ty, tz: real; # metres 60*37da2899SCharles.Forsyth s: real; # ppm 61*37da2899SCharles.Forsyth rx, ry, rz: real; # secs 62*37da2899SCharles.Forsyth}; 63*37da2899SCharles.Forsyth 64*37da2899SCharles.ForsythFormat: adt{ 65*37da2899SCharles.Forsyth dat: int; # datum 66*37da2899SCharles.Forsyth cdat: int; # converting datum 67*37da2899SCharles.Forsyth prj: int; # projection 68*37da2899SCharles.Forsyth tmp: ref Mercator; # actual projection 69*37da2899SCharles.Forsyth orig: Lalo; # origin of above projection 70*37da2899SCharles.Forsyth zone: int; # UTM zone 71*37da2899SCharles.Forsyth}; 72*37da2899SCharles.Forsyth 73*37da2899SCharles.Forsyth# ellipsoids 74*37da2899SCharles.Forsythells := array[] of { 75*37da2899SCharles.Forsyth Airy1830 => Ellipsoid("Airy1830", 6377563.396, 6356256.910), 76*37da2899SCharles.Forsyth Airy1830m => Ellipsoid("Airy1830 modified", 6377340.189, 6356034.447), 77*37da2899SCharles.Forsyth Int1924 => Ellipsoid("International 1924", 6378388.000, 6356911.946), 78*37da2899SCharles.Forsyth GRS80 => Ellipsoid("GRS80", 6378137.000, 6356752.3141), 79*37da2899SCharles.Forsyth }; 80*37da2899SCharles.Forsyth 81*37da2899SCharles.Forsyth# datums 82*37da2899SCharles.Forsythdats := array[] of { 83*37da2899SCharles.Forsyth OSGB36 => Datum("OSGB36", Airy1830), 84*37da2899SCharles.Forsyth Ireland65 => Datum("Ireland65", Airy1830m), 85*37da2899SCharles.Forsyth ED50 => Datum("ED50", Int1924), 86*37da2899SCharles.Forsyth WGS84 => Datum("WGS84", GRS80), 87*37da2899SCharles.Forsyth ITRS2000 => Datum("ITRS2000", GRS80), 88*37da2899SCharles.Forsyth ETRS89 => Datum("ETRS89", GRS80), 89*37da2899SCharles.Forsyth }; 90*37da2899SCharles.Forsyth 91*37da2899SCharles.Forsyth# transverse Mercator projections 92*37da2899SCharles.Forsythtmps := array[] of { 93*37da2899SCharles.Forsyth Natgrid => Mercator("National Grid", 0.9996012717, "49:00:00N 02:00:00W", real(4*Ngrid), real(-Ngrid), Airy1830), 94*37da2899SCharles.Forsyth IrishNatgrid => Mercator("Irish National Grid", 1.000035, "53:30:00N 08:00:00W", real(2*Ngrid), real(5*Ngrid/2), Airy1830m), 95*37da2899SCharles.Forsyth UTMEur => Mercator("UTM Europe", 0.9996, nil, real(5*Ngrid), real(0), Int1924), 96*37da2899SCharles.Forsyth UTM => Mercator("UTM", 0.9996, nil, real(5*Ngrid), real(0), GRS80), 97*37da2899SCharles.Forsyth }; 98*37da2899SCharles.Forsyth 99*37da2899SCharles.Forsyth# Helmert tranformations 100*37da2899SCharles.ForsythHT_WGS84_OSGB36: con Helmert(-446.448, 125.157, -542.060, 20.4894, -0.1502, -0.2470, -0.8421); 101*37da2899SCharles.ForsythHT_ITRS2000_ETRS89: con Helmert(0.054, 0.051, -0.048, 0.0, 0.000081*Δt, 0.00049*Δt, -0.000792*Δt); 102*37da2899SCharles.Forsyth 103*37da2899SCharles.Forsyth# Helmert matrices 104*37da2899SCharles.ForsythHM_WGS84_OSGB36, HM_OSGB36_WGS84, HM_ITRS2000_ETRS89, HM_ETRS89_ITRS2000, HM_ETRS89_OSGB36, HM_OSGB36_ETRS89, HM_IDENTITY: array of array of real; 105*37da2899SCharles.Forsyth 106*37da2899SCharles.Forsythfmt: ref Format; 107*37da2899SCharles.Forsyth 108*37da2899SCharles.Forsyth# latlong: ref Latlong; 109*37da2899SCharles.Forsyth 110*37da2899SCharles.Forsythinit(d: int, t: int, z: int) 111*37da2899SCharles.Forsyth{ 112*37da2899SCharles.Forsyth sys = load Sys Sys->PATH; 113*37da2899SCharles.Forsyth maths = load Math Math->PATH; 114*37da2899SCharles.Forsyth 115*37da2899SCharles.Forsyth helmertinit(); 116*37da2899SCharles.Forsyth format(d, t, z); 117*37da2899SCharles.Forsyth # (nil, (la, lo)) := str2lalo(lalo0); 118*37da2899SCharles.Forsyth # (nil, (E, N)) := os2en(os0); 119*37da2899SCharles.Forsyth # latlong = ref Latlong(la, lo, real E, real N); 120*37da2899SCharles.Forsyth} 121*37da2899SCharles.Forsyth 122*37da2899SCharles.Forsythformat(d: int, t: int, z: int) 123*37da2899SCharles.Forsyth{ 124*37da2899SCharles.Forsyth if(fmt == nil) 125*37da2899SCharles.Forsyth fmt = ref Format(WGS84, 0, Natgrid, nil, (0.0, 0.0), 30); 126*37da2899SCharles.Forsyth if(d >= 0 && d <= ETRS89) 127*37da2899SCharles.Forsyth fmt.dat = d; 128*37da2899SCharles.Forsyth if(t >= 0 && t <= UTM) 129*37da2899SCharles.Forsyth fmt.prj = t; 130*37da2899SCharles.Forsyth if(z >= 1 && z <= 60) 131*37da2899SCharles.Forsyth fmt.zone = z; 132*37da2899SCharles.Forsyth fmt.cdat = fmt.dat; 133*37da2899SCharles.Forsyth fmt.tmp = ref Mercator(tmps[fmt.prj]); 134*37da2899SCharles.Forsyth if(fmt.tmp.φ0λ0 == nil) 135*37da2899SCharles.Forsyth fmt.orig = utmlaloz(fmt.zone); 136*37da2899SCharles.Forsyth else 137*37da2899SCharles.Forsyth (nil, fmt.orig) = str2lalo(fmt.tmp.φ0λ0); 138*37da2899SCharles.Forsyth e := fmt.tmp.e; 139*37da2899SCharles.Forsyth if(e != dats[fmt.dat].e){ 140*37da2899SCharles.Forsyth for(i := 0; i <= ETRS89; i++) 141*37da2899SCharles.Forsyth if(e == dats[i].e){ 142*37da2899SCharles.Forsyth fmt.cdat = i; 143*37da2899SCharles.Forsyth break; 144*37da2899SCharles.Forsyth } 145*37da2899SCharles.Forsyth } 146*37da2899SCharles.Forsyth} 147*37da2899SCharles.Forsyth 148*37da2899SCharles.Forsythstr2en(s: string): (int, Eano) 149*37da2899SCharles.Forsyth{ 150*37da2899SCharles.Forsyth s = trim(s, " \t\n\r"); 151*37da2899SCharles.Forsyth if(s == nil) 152*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 153*37da2899SCharles.Forsyth os := s[0] >= 'A' && s[0] <= 'Z' || strchrs(s, "NSEW:") < 0; 154*37da2899SCharles.Forsyth en: Eano; 155*37da2899SCharles.Forsyth if(os){ 156*37da2899SCharles.Forsyth (ok, p) := os2en(s); 157*37da2899SCharles.Forsyth if(!ok) 158*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 159*37da2899SCharles.Forsyth en = p; 160*37da2899SCharles.Forsyth } 161*37da2899SCharles.Forsyth else{ 162*37da2899SCharles.Forsyth (ok, lalo) := str2lalo(s); 163*37da2899SCharles.Forsyth if(!ok) 164*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 165*37da2899SCharles.Forsyth en = lalo2en(lalo); 166*37da2899SCharles.Forsyth } 167*37da2899SCharles.Forsyth return (1, en); 168*37da2899SCharles.Forsyth} 169*37da2899SCharles.Forsyth 170*37da2899SCharles.Forsythstr2ll(s: string, pos: int, neg: int): (int, real) 171*37da2899SCharles.Forsyth{ 172*37da2899SCharles.Forsyth (n, ls) := sys->tokenize(s, ": \t"); 173*37da2899SCharles.Forsyth if(n < 1 || n > 3) 174*37da2899SCharles.Forsyth return (0, 0.0); 175*37da2899SCharles.Forsyth t := hd ls; ls = tl ls; 176*37da2899SCharles.Forsyth v := real t; 177*37da2899SCharles.Forsyth if(ls != nil){ 178*37da2899SCharles.Forsyth t = hd ls; ls = tl ls; 179*37da2899SCharles.Forsyth v += (real t)/60.0; 180*37da2899SCharles.Forsyth } 181*37da2899SCharles.Forsyth if(ls != nil){ 182*37da2899SCharles.Forsyth t = hd ls; ls = tl ls; 183*37da2899SCharles.Forsyth v += (real t)/3600.0; 184*37da2899SCharles.Forsyth } 185*37da2899SCharles.Forsyth c := t[len t-1]; 186*37da2899SCharles.Forsyth if(c == pos) 187*37da2899SCharles.Forsyth ; 188*37da2899SCharles.Forsyth else if(c == neg) 189*37da2899SCharles.Forsyth v = -v; 190*37da2899SCharles.Forsyth else 191*37da2899SCharles.Forsyth return (0, 0.0); 192*37da2899SCharles.Forsyth return (1, norm(deg2rad(v))); 193*37da2899SCharles.Forsyth} 194*37da2899SCharles.Forsyth 195*37da2899SCharles.Forsythstr2lalo(s: string): (int, Lalo) 196*37da2899SCharles.Forsyth{ 197*37da2899SCharles.Forsyth s = trim(s, " \t\n\r"); 198*37da2899SCharles.Forsyth p := strchr(s, 'N'); 199*37da2899SCharles.Forsyth if(p < 0) 200*37da2899SCharles.Forsyth p = strchr(s, 'S'); 201*37da2899SCharles.Forsyth if(p < 0) 202*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 203*37da2899SCharles.Forsyth (ok1, la) := str2ll(s[0: p+1], 'N', 'S'); 204*37da2899SCharles.Forsyth (ok2, lo) := str2ll(s[p+1: ], 'E', 'W'); 205*37da2899SCharles.Forsyth if(!ok1 || !ok2 || la < -Pi/2.0 || la > Pi/2.0) 206*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 207*37da2899SCharles.Forsyth return (1, (la, lo)); 208*37da2899SCharles.Forsyth} 209*37da2899SCharles.Forsyth 210*37da2899SCharles.Forsythll2str(ll: int, dir: string): string 211*37da2899SCharles.Forsyth{ 212*37da2899SCharles.Forsyth d := ll/360000; 213*37da2899SCharles.Forsyth ll -= 360000*d; 214*37da2899SCharles.Forsyth m := ll/6000; 215*37da2899SCharles.Forsyth ll -= 6000*m; 216*37da2899SCharles.Forsyth s := ll/100; 217*37da2899SCharles.Forsyth ll -= 100*s; 218*37da2899SCharles.Forsyth return d2(d) + ":" + d2(m) + ":" + d2(s) + "." + d2(ll) + dir; 219*37da2899SCharles.Forsyth} 220*37da2899SCharles.Forsyth 221*37da2899SCharles.Forsythlalo2str(lalo: Lalo): string 222*37da2899SCharles.Forsyth{ 223*37da2899SCharles.Forsyth la := int(360000.0*rad2deg(lalo.la)); 224*37da2899SCharles.Forsyth lo := int(360000.0*rad2deg(lalo.lo)); 225*37da2899SCharles.Forsyth lad := "N"; 226*37da2899SCharles.Forsyth lod := "E"; 227*37da2899SCharles.Forsyth if(la < 0){ 228*37da2899SCharles.Forsyth lad = "S"; 229*37da2899SCharles.Forsyth la = -la; 230*37da2899SCharles.Forsyth } 231*37da2899SCharles.Forsyth if(lo < 0){ 232*37da2899SCharles.Forsyth lod = "W"; 233*37da2899SCharles.Forsyth lo = -lo; 234*37da2899SCharles.Forsyth } 235*37da2899SCharles.Forsyth return ll2str(la, lad) + " " + ll2str(lo, lod); 236*37da2899SCharles.Forsyth} 237*37da2899SCharles.Forsyth 238*37da2899SCharles.Forsythen2os(p: Eano): string 239*37da2899SCharles.Forsyth{ 240*37da2899SCharles.Forsyth E := trunc(p.e); 241*37da2899SCharles.Forsyth N := trunc(p.n); 242*37da2899SCharles.Forsyth es := E/Ngrid; 243*37da2899SCharles.Forsyth ns := N/Ngrid; 244*37da2899SCharles.Forsyth e := E-Ngrid*es; 245*37da2899SCharles.Forsyth n := N-Ngrid*ns; 246*37da2899SCharles.Forsyth d1 := 5*(4-ns/5)+es/5+'A'-3; 247*37da2899SCharles.Forsyth d2 := 5*(4-ns%5)+es%5+'A'; 248*37da2899SCharles.Forsyth # now account for 'I' missing 249*37da2899SCharles.Forsyth if(d1 >= 'I') 250*37da2899SCharles.Forsyth d1++; 251*37da2899SCharles.Forsyth if(d2 >= 'I') 252*37da2899SCharles.Forsyth d2++; 253*37da2899SCharles.Forsyth return sys->sprint("%c%c%5.5d%5.5d", d1, d2, e, n); 254*37da2899SCharles.Forsyth} 255*37da2899SCharles.Forsyth 256*37da2899SCharles.Forsythos2en(s: string): (int, Eano) 257*37da2899SCharles.Forsyth{ 258*37da2899SCharles.Forsyth s = trim(s, " \t\n\r"); 259*37da2899SCharles.Forsyth if((m := len s) != 4 && m != 6 && m != 8 && m != 10 && m != 12) 260*37da2899SCharles.Forsyth return (0, (0.0, 0.0)); 261*37da2899SCharles.Forsyth m = m/2-1; 262*37da2899SCharles.Forsyth u := Ngrid/10**m; 263*37da2899SCharles.Forsyth d1 := s[0]; 264*37da2899SCharles.Forsyth d2 := s[1]; 265*37da2899SCharles.Forsyth if(d1 < 'A' || d2 < 'A' || d1 > 'Z' || d2 > 'Z'){ 266*37da2899SCharles.Forsyth # error(sys->sprint("bad os reference %s", s)); 267*37da2899SCharles.Forsyth e := u*int s[0: 1+m]; 268*37da2899SCharles.Forsyth n := u*int s[1+m: 2+2*m]; 269*37da2899SCharles.Forsyth return (1, (real e, real n)); 270*37da2899SCharles.Forsyth } 271*37da2899SCharles.Forsyth e := u*int s[2: 2+m]; 272*37da2899SCharles.Forsyth n := u*int s[2+m: 2+2*m]; 273*37da2899SCharles.Forsyth if(d1 >= 'I') 274*37da2899SCharles.Forsyth d1--; 275*37da2899SCharles.Forsyth if(d2 >= 'I') 276*37da2899SCharles.Forsyth d2--; 277*37da2899SCharles.Forsyth d1 -= 'A'-3; 278*37da2899SCharles.Forsyth d2 -= 'A'; 279*37da2899SCharles.Forsyth es := 5*(d1%5)+d2%5; 280*37da2899SCharles.Forsyth ns := 5*(4-d1/5)+4-d2/5; 281*37da2899SCharles.Forsyth return (1, (real(Ngrid*es+e), real(Ngrid*ns+n))); 282*37da2899SCharles.Forsyth} 283*37da2899SCharles.Forsyth 284*37da2899SCharles.Forsythutmlalo(lalo: Lalo): Lalo 285*37da2899SCharles.Forsyth{ 286*37da2899SCharles.Forsyth (nil, zn) := utmzone(lalo); 287*37da2899SCharles.Forsyth return utmlaloz(zn); 288*37da2899SCharles.Forsyth} 289*37da2899SCharles.Forsyth 290*37da2899SCharles.Forsythutmlaloz(zn: int): Lalo 291*37da2899SCharles.Forsyth{ 292*37da2899SCharles.Forsyth return (0.0, deg2rad(real(6*zn-183))); 293*37da2899SCharles.Forsyth} 294*37da2899SCharles.Forsyth 295*37da2899SCharles.Forsythutmzone(lalo: Lalo): (int, int) 296*37da2899SCharles.Forsyth{ 297*37da2899SCharles.Forsyth (la, lo) := lalo; 298*37da2899SCharles.Forsyth la = rad2deg(la); 299*37da2899SCharles.Forsyth lo = rad2deg(lo); 300*37da2899SCharles.Forsyth zlo := trunc(lo+180.0)/6+1; 301*37da2899SCharles.Forsyth if(la < -80.0) 302*37da2899SCharles.Forsyth zla := 'B'; 303*37da2899SCharles.Forsyth else if(la >= 84.0) 304*37da2899SCharles.Forsyth zla = 'Y'; 305*37da2899SCharles.Forsyth else if(la >= 72.0) 306*37da2899SCharles.Forsyth zla = 'X'; 307*37da2899SCharles.Forsyth else{ 308*37da2899SCharles.Forsyth zla = trunc(la+80.0)/8+'C'; 309*37da2899SCharles.Forsyth if(zla >= 'I') 310*37da2899SCharles.Forsyth zla++; 311*37da2899SCharles.Forsyth if(zla >= 'O') 312*37da2899SCharles.Forsyth zla++; 313*37da2899SCharles.Forsyth } 314*37da2899SCharles.Forsyth return (zla, zlo); 315*37da2899SCharles.Forsyth} 316*37da2899SCharles.Forsyth 317*37da2899SCharles.Forsythhelmertinit() 318*37da2899SCharles.Forsyth{ 319*37da2899SCharles.Forsyth (HM_WGS84_OSGB36, HM_OSGB36_WGS84) = helminit(HT_WGS84_OSGB36); 320*37da2899SCharles.Forsyth (HM_ITRS2000_ETRS89, HM_ETRS89_ITRS2000) = helminit(HT_ITRS2000_ETRS89); 321*37da2899SCharles.Forsyth HM_ETRS89_OSGB36 = mulmm(HM_WGS84_OSGB36, HM_ETRS89_ITRS2000); 322*37da2899SCharles.Forsyth HM_OSGB36_ETRS89 = mulmm(HM_ITRS2000_ETRS89, HM_OSGB36_WGS84); 323*37da2899SCharles.Forsyth HM_IDENTITY = m := matrix(3, 4); 324*37da2899SCharles.Forsyth m[0][0] = m[1][1] = m[2][2] = 1.0; 325*37da2899SCharles.Forsyth # mprint(HM_WGS84_OSGB36); 326*37da2899SCharles.Forsyth # mprint(HM_OSGB36_WGS84); 327*37da2899SCharles.Forsyth} 328*37da2899SCharles.Forsyth 329*37da2899SCharles.Forsythhelminit(h: Helmert): (array of array of real, array of array of real) 330*37da2899SCharles.Forsyth{ 331*37da2899SCharles.Forsyth m := matrix(3, 4); 332*37da2899SCharles.Forsyth 333*37da2899SCharles.Forsyth s := 1.0+h.s/1000000.0; 334*37da2899SCharles.Forsyth rx := sec2rad(h.rx); 335*37da2899SCharles.Forsyth ry := sec2rad(h.ry); 336*37da2899SCharles.Forsyth rz := sec2rad(h.rz); 337*37da2899SCharles.Forsyth 338*37da2899SCharles.Forsyth m[0][0] = s; 339*37da2899SCharles.Forsyth m[0][1] = -rz; 340*37da2899SCharles.Forsyth m[0][2] = ry; 341*37da2899SCharles.Forsyth m[0][3] = h.tx; 342*37da2899SCharles.Forsyth m[1][0] = rz; 343*37da2899SCharles.Forsyth m[1][1] = s; 344*37da2899SCharles.Forsyth m[1][2] = -rx; 345*37da2899SCharles.Forsyth m[1][3] = h.ty; 346*37da2899SCharles.Forsyth m[2][0] = -ry; 347*37da2899SCharles.Forsyth m[2][1] = rx; 348*37da2899SCharles.Forsyth m[2][2] = s; 349*37da2899SCharles.Forsyth m[2][3] = h.tz; 350*37da2899SCharles.Forsyth 351*37da2899SCharles.Forsyth return (m, inv(m)); 352*37da2899SCharles.Forsyth} 353*37da2899SCharles.Forsyth 354*37da2899SCharles.Forsythtrans(f: int, t: int): array of array of real 355*37da2899SCharles.Forsyth{ 356*37da2899SCharles.Forsyth case(f){ 357*37da2899SCharles.Forsyth WGS84 => 358*37da2899SCharles.Forsyth case(t){ 359*37da2899SCharles.Forsyth WGS84 => 360*37da2899SCharles.Forsyth return HM_IDENTITY; 361*37da2899SCharles.Forsyth OSGB36 => 362*37da2899SCharles.Forsyth return HM_WGS84_OSGB36; 363*37da2899SCharles.Forsyth ITRS2000 => 364*37da2899SCharles.Forsyth return HM_IDENTITY; 365*37da2899SCharles.Forsyth ETRS89 => 366*37da2899SCharles.Forsyth return HM_ITRS2000_ETRS89; 367*37da2899SCharles.Forsyth } 368*37da2899SCharles.Forsyth OSGB36 => 369*37da2899SCharles.Forsyth case(t){ 370*37da2899SCharles.Forsyth WGS84 => 371*37da2899SCharles.Forsyth return HM_OSGB36_WGS84; 372*37da2899SCharles.Forsyth OSGB36 => 373*37da2899SCharles.Forsyth return HM_IDENTITY; 374*37da2899SCharles.Forsyth ITRS2000 => 375*37da2899SCharles.Forsyth return HM_OSGB36_WGS84; 376*37da2899SCharles.Forsyth ETRS89 => 377*37da2899SCharles.Forsyth return HM_OSGB36_ETRS89; 378*37da2899SCharles.Forsyth } 379*37da2899SCharles.Forsyth ITRS2000 => 380*37da2899SCharles.Forsyth case(t){ 381*37da2899SCharles.Forsyth WGS84 => 382*37da2899SCharles.Forsyth return HM_IDENTITY; 383*37da2899SCharles.Forsyth OSGB36 => 384*37da2899SCharles.Forsyth return HM_WGS84_OSGB36; 385*37da2899SCharles.Forsyth ITRS2000 => 386*37da2899SCharles.Forsyth return HM_IDENTITY; 387*37da2899SCharles.Forsyth ETRS89 => 388*37da2899SCharles.Forsyth return HM_ITRS2000_ETRS89; 389*37da2899SCharles.Forsyth } 390*37da2899SCharles.Forsyth ETRS89 => 391*37da2899SCharles.Forsyth case(t){ 392*37da2899SCharles.Forsyth WGS84 => 393*37da2899SCharles.Forsyth return HM_ETRS89_ITRS2000; 394*37da2899SCharles.Forsyth OSGB36 => 395*37da2899SCharles.Forsyth return HM_ETRS89_OSGB36; 396*37da2899SCharles.Forsyth ITRS2000 => 397*37da2899SCharles.Forsyth return HM_ETRS89_ITRS2000; 398*37da2899SCharles.Forsyth ETRS89 => 399*37da2899SCharles.Forsyth return HM_IDENTITY; 400*37da2899SCharles.Forsyth } 401*37da2899SCharles.Forsyth } 402*37da2899SCharles.Forsyth return HM_IDENTITY; # Ireland65, ED50 not done 403*37da2899SCharles.Forsyth} 404*37da2899SCharles.Forsyth 405*37da2899SCharles.Forsythdatum2datum(lalo: Lalo, f: int, t: int): Lalo 406*37da2899SCharles.Forsyth{ 407*37da2899SCharles.Forsyth if(f == t) 408*37da2899SCharles.Forsyth return lalo; 409*37da2899SCharles.Forsyth (la, lo) := lalo; 410*37da2899SCharles.Forsyth v := laloh2xyz(la, lo, 0.0, dats[f].e); 411*37da2899SCharles.Forsyth v = mulmv(trans(f, t), v); 412*37da2899SCharles.Forsyth (la, lo, nil) = xyz2laloh(v, dats[t].e); 413*37da2899SCharles.Forsyth return (la, lo); 414*37da2899SCharles.Forsyth} 415*37da2899SCharles.Forsyth 416*37da2899SCharles.Forsythlaloh2xyz(φ: real, λ: real, H: real, e: int): Vector 417*37da2899SCharles.Forsyth{ 418*37da2899SCharles.Forsyth a := ells[e].a; 419*37da2899SCharles.Forsyth b := ells[e].b; 420*37da2899SCharles.Forsyth e2 := 1.0-(b/a)**2; 421*37da2899SCharles.Forsyth 422*37da2899SCharles.Forsyth s := sin(φ); 423*37da2899SCharles.Forsyth c := cos(φ); 424*37da2899SCharles.Forsyth 425*37da2899SCharles.Forsyth ν := a/sqrt(1.0-e2*s*s); 426*37da2899SCharles.Forsyth x := (ν+H)*c*cos(λ); 427*37da2899SCharles.Forsyth y := (ν+H)*c*sin(λ); 428*37da2899SCharles.Forsyth z := ((1.0-e2)*ν+H)*s; 429*37da2899SCharles.Forsyth 430*37da2899SCharles.Forsyth return (x, y, z); 431*37da2899SCharles.Forsyth} 432*37da2899SCharles.Forsyth 433*37da2899SCharles.Forsythxyz2laloh(v: Vector, e: int): (real, real, real) 434*37da2899SCharles.Forsyth{ 435*37da2899SCharles.Forsyth x := v.x; 436*37da2899SCharles.Forsyth y := v.y; 437*37da2899SCharles.Forsyth z := v.z; 438*37da2899SCharles.Forsyth 439*37da2899SCharles.Forsyth a := ells[e].a; 440*37da2899SCharles.Forsyth b := ells[e].b; 441*37da2899SCharles.Forsyth e2 := 1.0-(b/a)**2; 442*37da2899SCharles.Forsyth 443*37da2899SCharles.Forsyth λ := atan2(y, x); 444*37da2899SCharles.Forsyth 445*37da2899SCharles.Forsyth p := sqrt(x*x+y*y); 446*37da2899SCharles.Forsyth φ := φ1 := atan(z/(p*(1.0-e2))); 447*37da2899SCharles.Forsyth ν := 0.0; 448*37da2899SCharles.Forsyth do{ 449*37da2899SCharles.Forsyth φ = φ1; 450*37da2899SCharles.Forsyth s := sin(φ); 451*37da2899SCharles.Forsyth ν = a/sqrt(1.0-e2*s*s); 452*37da2899SCharles.Forsyth φ1 = atan((z+e2*ν*s)/p); 453*37da2899SCharles.Forsyth }while(!small(fabs(φ-φ1))); 454*37da2899SCharles.Forsyth 455*37da2899SCharles.Forsyth φ = φ1; 456*37da2899SCharles.Forsyth H := p/cos(φ)-ν; 457*37da2899SCharles.Forsyth 458*37da2899SCharles.Forsyth return (φ, λ, H); 459*37da2899SCharles.Forsyth} 460*37da2899SCharles.Forsyth 461*37da2899SCharles.Forsythlalo2en(lalo: Lalo): Eano 462*37da2899SCharles.Forsyth{ 463*37da2899SCharles.Forsyth (φ, λ) := lalo; 464*37da2899SCharles.Forsyth if(fmt.cdat != fmt.dat) 465*37da2899SCharles.Forsyth (φ, λ) = datum2datum(lalo, fmt.dat, fmt.cdat); 466*37da2899SCharles.Forsyth 467*37da2899SCharles.Forsyth s := sin(φ); 468*37da2899SCharles.Forsyth c := cos(φ); 469*37da2899SCharles.Forsyth t2 := tan(φ)**2; 470*37da2899SCharles.Forsyth 471*37da2899SCharles.Forsyth (nil, F0, φ0λ0, E0, N0, e) := *fmt.tmp; 472*37da2899SCharles.Forsyth a := ells[e].a; 473*37da2899SCharles.Forsyth b := ells[e].b; 474*37da2899SCharles.Forsyth e2 := 1.0-(b/a)**2; 475*37da2899SCharles.Forsyth 476*37da2899SCharles.Forsyth if(φ0λ0 == nil) # UTM 477*37da2899SCharles.Forsyth (φ0, λ0) := utmlalo((φ, λ)); # don't use fmt.zone here 478*37da2899SCharles.Forsyth else 479*37da2899SCharles.Forsyth (φ0, λ0) = fmt.orig; 480*37da2899SCharles.Forsyth 481*37da2899SCharles.Forsyth n := (a-b)/(a+b); 482*37da2899SCharles.Forsyth ν := a*F0/sqrt(1.0-e2*s*s); 483*37da2899SCharles.Forsyth ρ := ν*(1.0-e2)/(1.0-e2*s*s); 484*37da2899SCharles.Forsyth η2 := ν/ρ-1.0; 485*37da2899SCharles.Forsyth 486*37da2899SCharles.Forsyth φ1 := φ-φ0; 487*37da2899SCharles.Forsyth φ2 := φ+φ0; 488*37da2899SCharles.Forsyth M := b*F0*((1.0+n*(1.0+1.25*n*(1.0+n)))*φ1 - (3.0*n*(1.0+n*(1.0+0.875*n)))*sin(φ1)*cos(φ2) + 1.875*n*n*(1.0+n)*sin(2.0*φ1)*cos(2.0*φ2) - 35.0/24.0*n**3*sin(3.0*φ1)*cos(3.0*φ2)); 489*37da2899SCharles.Forsyth 490*37da2899SCharles.Forsyth I := M+N0; 491*37da2899SCharles.Forsyth II := ν*s*c/2.0; 492*37da2899SCharles.Forsyth III := ν*s*c**3*(5.0-t2+9.0*η2)/24.0; 493*37da2899SCharles.Forsyth IIIA := ν*s*c**5*(61.0+t2*(t2-58.0))/720.0; 494*37da2899SCharles.Forsyth IV := ν*c; 495*37da2899SCharles.Forsyth V := ν*c**3*(ν/ρ-t2)/6.0; 496*37da2899SCharles.Forsyth VI := ν*c**5*(5.0+14.0*η2+t2*(t2-18.0-58.0*η2))/120.0; 497*37da2899SCharles.Forsyth 498*37da2899SCharles.Forsyth λ -= λ0; 499*37da2899SCharles.Forsyth λ2 := λ*λ; 500*37da2899SCharles.Forsyth N := I+λ2*(II+λ2*(III+IIIA*λ2)); 501*37da2899SCharles.Forsyth E := E0+λ*(IV+λ2*(V+VI*λ2)); 502*37da2899SCharles.Forsyth 503*37da2899SCharles.Forsyth # if(E < 0.0 || E >= real(7*Ngrid)) 504*37da2899SCharles.Forsyth # E = 0.0; 505*37da2899SCharles.Forsyth # if(N < 0.0 || N >= real(13*Ngrid)) 506*37da2899SCharles.Forsyth # N = 0.0; 507*37da2899SCharles.Forsyth return (E, N); 508*37da2899SCharles.Forsyth} 509*37da2899SCharles.Forsyth 510*37da2899SCharles.Forsythen2lalo(en: Eano): Lalo 511*37da2899SCharles.Forsyth{ 512*37da2899SCharles.Forsyth E := en.e; 513*37da2899SCharles.Forsyth N := en.n; 514*37da2899SCharles.Forsyth 515*37da2899SCharles.Forsyth (nil, F0, nil, E0, N0, e) := *fmt.tmp; 516*37da2899SCharles.Forsyth a := ells[e].a; 517*37da2899SCharles.Forsyth b := ells[e].b; 518*37da2899SCharles.Forsyth e2 := 1.0-(b/a)**2; 519*37da2899SCharles.Forsyth 520*37da2899SCharles.Forsyth (φ0, λ0) := fmt.orig; 521*37da2899SCharles.Forsyth 522*37da2899SCharles.Forsyth n := (a-b)/(a+b); 523*37da2899SCharles.Forsyth 524*37da2899SCharles.Forsyth M0 := 1.0+n*(1.0+1.25*n*(1.0+n)); 525*37da2899SCharles.Forsyth M1 := 3.0*n*(1.0+n*(1.0+0.875*n)); 526*37da2899SCharles.Forsyth M2 := 1.875*n*n*(1.0+n); 527*37da2899SCharles.Forsyth M3 := 35.0/24.0*n**3; 528*37da2899SCharles.Forsyth 529*37da2899SCharles.Forsyth N -= N0; 530*37da2899SCharles.Forsyth M := 0.0; 531*37da2899SCharles.Forsyth φ := φold := φ0; 532*37da2899SCharles.Forsyth do{ 533*37da2899SCharles.Forsyth φ = (N-M)/(a*F0)+φold; 534*37da2899SCharles.Forsyth φ1 := φ-φ0; 535*37da2899SCharles.Forsyth φ2 := φ+φ0; 536*37da2899SCharles.Forsyth M = b*F0*(M0*φ1 - M1*sin(φ1)*cos(φ2) + M2*sin(2.0*φ1)*cos(2.0*φ2) - M3*sin(3.0*φ1)*cos(3.0*φ2)); 537*37da2899SCharles.Forsyth φold = φ; 538*37da2899SCharles.Forsyth }while(fabs(N-M) >= 0.01); 539*37da2899SCharles.Forsyth 540*37da2899SCharles.Forsyth s := sin(φ); 541*37da2899SCharles.Forsyth c := cos(φ); 542*37da2899SCharles.Forsyth t := tan(φ); 543*37da2899SCharles.Forsyth t2 := t*t; 544*37da2899SCharles.Forsyth 545*37da2899SCharles.Forsyth ν := a*F0/sqrt(1.0-e2*s*s); 546*37da2899SCharles.Forsyth ρ := ν*(1.0-e2)/(1.0-e2*s*s); 547*37da2899SCharles.Forsyth η2 := ν/ρ-1.0; 548*37da2899SCharles.Forsyth 549*37da2899SCharles.Forsyth VII := t/(2.0*ρ*ν); 550*37da2899SCharles.Forsyth VIII := VII*(5.0+η2+3.0*t2*(1.0-3.0*η2))/(12.0*ν*ν); 551*37da2899SCharles.Forsyth IX := VII*(61.0+45.0*t2*(2.0+t2))/(360.0*ν**4); 552*37da2899SCharles.Forsyth X := 1.0/(ν*c); 553*37da2899SCharles.Forsyth XI := X*(ν/ρ+2.0*t2)/(6.0*ν*ν); 554*37da2899SCharles.Forsyth XII := X*(5.0+4.0*t2*(7.0+6.0*t2))/(120.0*ν**4); 555*37da2899SCharles.Forsyth XIIA := X*(61.0+2.0*t2*(331.0+60.0*t2*(11.0+6.0*t2)))/(5040.0*ν**6); 556*37da2899SCharles.Forsyth 557*37da2899SCharles.Forsyth E -= E0; 558*37da2899SCharles.Forsyth E2 := E*E; 559*37da2899SCharles.Forsyth φ = φ-E2*(VII-E2*(VIII-E2*IX)); 560*37da2899SCharles.Forsyth λ := λ0+E*(X-E2*(XI-E2*(XII-E2*XIIA))); 561*37da2899SCharles.Forsyth 562*37da2899SCharles.Forsyth if(fmt.cdat != fmt.dat) 563*37da2899SCharles.Forsyth (φ, λ) = datum2datum((φ, λ), fmt.cdat, fmt.dat); 564*37da2899SCharles.Forsyth return (φ, λ); 565*37da2899SCharles.Forsyth} 566*37da2899SCharles.Forsyth 567*37da2899SCharles.Forsythmulmm(m1: array of array of real, m2: array of array of real): array of array of real 568*37da2899SCharles.Forsyth{ 569*37da2899SCharles.Forsyth m := matrix(3, 4); 570*37da2899SCharles.Forsyth mul3x3(m, m1, m2); 571*37da2899SCharles.Forsyth for(i := 0; i < 3; i++){ 572*37da2899SCharles.Forsyth sum := 0.0; 573*37da2899SCharles.Forsyth for(k := 0; k < 3; k++) 574*37da2899SCharles.Forsyth sum += m1[i][k]*m2[k][3]; 575*37da2899SCharles.Forsyth m[i][3] = sum+m1[i][3]; 576*37da2899SCharles.Forsyth } 577*37da2899SCharles.Forsyth return m; 578*37da2899SCharles.Forsyth} 579*37da2899SCharles.Forsyth 580*37da2899SCharles.Forsythmulmv(m: array of array of real, v: Vector): Vector 581*37da2899SCharles.Forsyth{ 582*37da2899SCharles.Forsyth x := v.x; 583*37da2899SCharles.Forsyth y := v.y; 584*37da2899SCharles.Forsyth z := v.z; 585*37da2899SCharles.Forsyth v.x = m[0][0]*x + m[0][1]*y + m[0][2]*z + m[0][3]; 586*37da2899SCharles.Forsyth v.y = m[1][0]*x + m[1][1]*y + m[1][2]*z + m[1][3]; 587*37da2899SCharles.Forsyth v.z = m[2][0]*x + m[2][1]*y + m[2][2]*z + m[2][3]; 588*37da2899SCharles.Forsyth return v; 589*37da2899SCharles.Forsyth} 590*37da2899SCharles.Forsyth 591*37da2899SCharles.Forsythinv(m: array of array of real): array of array of real 592*37da2899SCharles.Forsyth{ 593*37da2899SCharles.Forsyth n := matrix(3, 4); 594*37da2899SCharles.Forsyth inv3x3(m, n); 595*37da2899SCharles.Forsyth (n[0][3], n[1][3], n[2][3]) = mulmv(n, (-m[0][3], -m[1][3], -m[2][3])); 596*37da2899SCharles.Forsyth return n; 597*37da2899SCharles.Forsyth} 598*37da2899SCharles.Forsyth 599*37da2899SCharles.Forsythmul3x3(m: array of array of real, m1: array of array of real, m2: array of array of real) 600*37da2899SCharles.Forsyth{ 601*37da2899SCharles.Forsyth for(i := 0; i < 3; i++){ 602*37da2899SCharles.Forsyth for(j := 0; j < 3; j++){ 603*37da2899SCharles.Forsyth sum := 0.0; 604*37da2899SCharles.Forsyth for(k := 0; k < 3; k++) 605*37da2899SCharles.Forsyth sum += m1[i][k]*m2[k][j]; 606*37da2899SCharles.Forsyth m[i][j] = sum; 607*37da2899SCharles.Forsyth } 608*37da2899SCharles.Forsyth } 609*37da2899SCharles.Forsyth} 610*37da2899SCharles.Forsyth 611*37da2899SCharles.Forsythinv3x3(m: array of array of real, n: array of array of real) 612*37da2899SCharles.Forsyth{ 613*37da2899SCharles.Forsyth t00 := m[0][0]; 614*37da2899SCharles.Forsyth t01 := m[0][1]; 615*37da2899SCharles.Forsyth t02 := m[0][2]; 616*37da2899SCharles.Forsyth t10 := m[1][0]; 617*37da2899SCharles.Forsyth t11 := m[1][1]; 618*37da2899SCharles.Forsyth t12 := m[1][2]; 619*37da2899SCharles.Forsyth t20 := m[2][0]; 620*37da2899SCharles.Forsyth t21 := m[2][1]; 621*37da2899SCharles.Forsyth t22 := m[2][2]; 622*37da2899SCharles.Forsyth 623*37da2899SCharles.Forsyth n[0][0] = t11*t22-t12*t21; 624*37da2899SCharles.Forsyth n[1][0] = t12*t20-t10*t22; 625*37da2899SCharles.Forsyth n[2][0] = t10*t21-t11*t20; 626*37da2899SCharles.Forsyth n[0][1] = t02*t21-t01*t22; 627*37da2899SCharles.Forsyth n[1][1] = t00*t22-t02*t20; 628*37da2899SCharles.Forsyth n[2][1] = t01*t20-t00*t21; 629*37da2899SCharles.Forsyth n[0][2] = t01*t12-t02*t11; 630*37da2899SCharles.Forsyth n[1][2] = t02*t10-t00*t12; 631*37da2899SCharles.Forsyth n[2][2] = t00*t11-t01*t10; 632*37da2899SCharles.Forsyth 633*37da2899SCharles.Forsyth d := t00*n[0][0]+t01*n[1][0]+t02*n[2][0]; 634*37da2899SCharles.Forsyth for(i := 0; i < 3; i++) 635*37da2899SCharles.Forsyth for(j := 0; j < 3; j++) 636*37da2899SCharles.Forsyth n[i][j] /= d; 637*37da2899SCharles.Forsyth} 638*37da2899SCharles.Forsyth 639*37da2899SCharles.Forsythmatrix(rows: int, cols: int): array of array of real 640*37da2899SCharles.Forsyth{ 641*37da2899SCharles.Forsyth m := array[rows] of array of real; 642*37da2899SCharles.Forsyth for(i := 0; i < rows; i++) 643*37da2899SCharles.Forsyth m[i] = array[cols] of { * => 0.0 }; 644*37da2899SCharles.Forsyth return m; 645*37da2899SCharles.Forsyth} 646*37da2899SCharles.Forsyth 647*37da2899SCharles.Forsythvprint(v: Vector) 648*37da2899SCharles.Forsyth{ 649*37da2899SCharles.Forsyth sys->print(" %f %f %f\n", v.x, v.y, v.z); 650*37da2899SCharles.Forsyth} 651*37da2899SCharles.Forsyth 652*37da2899SCharles.Forsythmprint(m: array of array of real) 653*37da2899SCharles.Forsyth{ 654*37da2899SCharles.Forsyth for(i := 0; i < len m; i++){ 655*37da2899SCharles.Forsyth for(j := 0; j < len m[i]; j++) 656*37da2899SCharles.Forsyth sys->print(" %f", m[i][j]); 657*37da2899SCharles.Forsyth sys->print("\n"); 658*37da2899SCharles.Forsyth } 659*37da2899SCharles.Forsyth} 660*37da2899SCharles.Forsyth 661*37da2899SCharles.Forsyth# lalo2xy(la: real, lo: real, lalo: ref Latlong): Eano 662*37da2899SCharles.Forsyth# { 663*37da2899SCharles.Forsyth# x, y: real; 664*37da2899SCharles.Forsyth# 665*37da2899SCharles.Forsyth# la0 := lalo.la; 666*37da2899SCharles.Forsyth# lo0 := lalo.lo; 667*37da2899SCharles.Forsyth# if(Approx){ 668*37da2899SCharles.Forsyth# x = Earthrad*cos(la0)*(lo-lo0)+lalo.x; 669*37da2899SCharles.Forsyth# y = Earthrad*(la-la0)+lalo.y; 670*37da2899SCharles.Forsyth# } 671*37da2899SCharles.Forsyth# else{ 672*37da2899SCharles.Forsyth# x = Earthrad*cos(la)*sin(lo-lo0)+lalo.x; 673*37da2899SCharles.Forsyth# y = Earthrad*(sin(la)*cos(la0)-sin(la0)*cos(la)*cos(lo-lo0))+lalo.y; 674*37da2899SCharles.Forsyth# } 675*37da2899SCharles.Forsyth# return (x, y); 676*37da2899SCharles.Forsyth# } 677*37da2899SCharles.Forsyth 678*37da2899SCharles.Forsyth# lalo2xyz(la: real, lo: real, lalo: ref Latlong): (int, int, int) 679*37da2899SCharles.Forsyth# { 680*37da2899SCharles.Forsyth# z: real; 681*37da2899SCharles.Forsyth# 682*37da2899SCharles.Forsyth# la0 := lalo.la; 683*37da2899SCharles.Forsyth# lo0 := lalo.lo; 684*37da2899SCharles.Forsyth# (x, y) := lalo2xy(la, lo, lalo); 685*37da2899SCharles.Forsyth# if(Approx) 686*37da2899SCharles.Forsyth# z = Earthrad; 687*37da2899SCharles.Forsyth# else 688*37da2899SCharles.Forsyth# z = Earthrad*(sin(la)*sin(la0)+cos(la)*cos(la0)*cos(lo-lo0)); 689*37da2899SCharles.Forsyth# return (x, y, int z); 690*37da2899SCharles.Forsyth# } 691*37da2899SCharles.Forsyth 692*37da2899SCharles.Forsyth# xy2lalo(p: Eano, lalo: ref Latlong): (real, real) 693*37da2899SCharles.Forsyth# { 694*37da2899SCharles.Forsyth# la, lo: real; 695*37da2899SCharles.Forsyth# 696*37da2899SCharles.Forsyth# x := p.e; 697*37da2899SCharles.Forsyth# y := p.n; 698*37da2899SCharles.Forsyth# la0 := lalo.la; 699*37da2899SCharles.Forsyth# lo0 := lalo.lo; 700*37da2899SCharles.Forsyth# if(Approx){ 701*37da2899SCharles.Forsyth# la = la0 + (y-lalo.y)/Earthrad; 702*37da2899SCharles.Forsyth# lo = lo0 + (x-lalo.x)/(Earthrad*cos(la0)); 703*37da2899SCharles.Forsyth# } 704*37da2899SCharles.Forsyth# else{ 705*37da2899SCharles.Forsyth# a, b, c, d, bestd, r, r1, r2, lat, lon, tmp: real; 706*37da2899SCharles.Forsyth# i, n: int; 707*37da2899SCharles.Forsyth# 708*37da2899SCharles.Forsyth# bestd = -1.0; 709*37da2899SCharles.Forsyth# la = lo = 0.0; 710*37da2899SCharles.Forsyth# a = (x-lalo.x)/Earthrad; 711*37da2899SCharles.Forsyth# b = (y-lalo.y)/Earthrad; 712*37da2899SCharles.Forsyth# (n, r1, r2) = quad(1.0, -2.0*b*cos(la0), (a*a-1.0)*sin(la0)*sin(la0)+b*b); 713*37da2899SCharles.Forsyth# if(n == 0) 714*37da2899SCharles.Forsyth# return (la, lo); 715*37da2899SCharles.Forsyth# while(--n >= 0){ 716*37da2899SCharles.Forsyth# if(n == 1) 717*37da2899SCharles.Forsyth# r = r2; 718*37da2899SCharles.Forsyth# else 719*37da2899SCharles.Forsyth# r = r1; 720*37da2899SCharles.Forsyth# if(fabs(r) <= 1.0){ 721*37da2899SCharles.Forsyth# lat = asin(r); 722*37da2899SCharles.Forsyth# c = cos(lat); 723*37da2899SCharles.Forsyth# if(small(c)) 724*37da2899SCharles.Forsyth# tmp = 0.0; # lat = +90, -90, lon = lo0 725*37da2899SCharles.Forsyth# else 726*37da2899SCharles.Forsyth# tmp = a/c; 727*37da2899SCharles.Forsyth# if(fabs(tmp) <= 1.0){ 728*37da2899SCharles.Forsyth# for(i = 0; i < 2; i++){ 729*37da2899SCharles.Forsyth# if(i == 0) 730*37da2899SCharles.Forsyth# lon = norm(asin(tmp)+lo0); 731*37da2899SCharles.Forsyth# else 732*37da2899SCharles.Forsyth# lon = norm(Pi-asin(tmp)+lo0); 733*37da2899SCharles.Forsyth# (X, Y, Z) := lalo2xyz(lat, lon, lalo); 734*37da2899SCharles.Forsyth# # eliminate non-roots by d, root on other side of earth by Z 735*37da2899SCharles.Forsyth# d = (real X-x)**2+(real Y-y)**2; 736*37da2899SCharles.Forsyth# if(Z >= 0 && (bestd < 0.0 || d < bestd)){ 737*37da2899SCharles.Forsyth# bestd = d; 738*37da2899SCharles.Forsyth# la = lat; 739*37da2899SCharles.Forsyth# lo = lon; 740*37da2899SCharles.Forsyth# } 741*37da2899SCharles.Forsyth# } 742*37da2899SCharles.Forsyth# } 743*37da2899SCharles.Forsyth# } 744*37da2899SCharles.Forsyth# } 745*37da2899SCharles.Forsyth# } 746*37da2899SCharles.Forsyth# return (la, lo); 747*37da2899SCharles.Forsyth# } 748*37da2899SCharles.Forsyth 749*37da2899SCharles.Forsyth# quad(a: real, b: real, c: real): (int, real, real) 750*37da2899SCharles.Forsyth# { 751*37da2899SCharles.Forsyth# r1, r2: real; 752*37da2899SCharles.Forsyth# 753*37da2899SCharles.Forsyth# D := b*b-4.0*a*c; 754*37da2899SCharles.Forsyth# if(small(a)){ 755*37da2899SCharles.Forsyth# if(small(b)) 756*37da2899SCharles.Forsyth# return (0, r1, r2); 757*37da2899SCharles.Forsyth# r1 = r2 = -c/b; 758*37da2899SCharles.Forsyth# return (1, r1, r2); 759*37da2899SCharles.Forsyth# } 760*37da2899SCharles.Forsyth# if(D < 0.0) 761*37da2899SCharles.Forsyth# return (0, r1, r2); 762*37da2899SCharles.Forsyth# D = sqrt(D); 763*37da2899SCharles.Forsyth# r1 = (-b+D)/(2.0*a); 764*37da2899SCharles.Forsyth# r2 = (-b-D)/(2.0*a); 765*37da2899SCharles.Forsyth# if(small(D)) 766*37da2899SCharles.Forsyth# return (1, r1, r2); 767*37da2899SCharles.Forsyth# else 768*37da2899SCharles.Forsyth# return (2, r1, r2); 769*37da2899SCharles.Forsyth# } 770*37da2899SCharles.Forsyth 771*37da2899SCharles.Forsythd2(v: int): string 772*37da2899SCharles.Forsyth{ 773*37da2899SCharles.Forsyth s := string v; 774*37da2899SCharles.Forsyth if(v < 10) 775*37da2899SCharles.Forsyth s = "0" + s; 776*37da2899SCharles.Forsyth return s; 777*37da2899SCharles.Forsyth} 778*37da2899SCharles.Forsyth 779*37da2899SCharles.Forsythtrim(s: string, t: string): string 780*37da2899SCharles.Forsyth{ 781*37da2899SCharles.Forsyth while(s != nil && strchr(t, s[0]) >= 0) 782*37da2899SCharles.Forsyth s = s[1: ]; 783*37da2899SCharles.Forsyth while(s != nil && strchr(t, s[len s-1]) >= 0) 784*37da2899SCharles.Forsyth s = s[0: len s-1]; 785*37da2899SCharles.Forsyth return s; 786*37da2899SCharles.Forsyth} 787*37da2899SCharles.Forsyth 788*37da2899SCharles.Forsythstrchrs(s: string, t: string): int 789*37da2899SCharles.Forsyth{ 790*37da2899SCharles.Forsyth for(i := 0; i < len t; i++){ 791*37da2899SCharles.Forsyth p := strchr(s, t[i]); 792*37da2899SCharles.Forsyth if(p >= 0) 793*37da2899SCharles.Forsyth return p; 794*37da2899SCharles.Forsyth } 795*37da2899SCharles.Forsyth return -1; 796*37da2899SCharles.Forsyth} 797*37da2899SCharles.Forsyth 798*37da2899SCharles.Forsythstrchr(s: string, c: int): int 799*37da2899SCharles.Forsyth{ 800*37da2899SCharles.Forsyth for(i := 0; i < len s; i++) 801*37da2899SCharles.Forsyth if(s[i] == c) 802*37da2899SCharles.Forsyth return i; 803*37da2899SCharles.Forsyth return -1; 804*37da2899SCharles.Forsyth} 805*37da2899SCharles.Forsyth 806*37da2899SCharles.Forsythdeg2rad(d: real): real 807*37da2899SCharles.Forsyth{ 808*37da2899SCharles.Forsyth return d*Pi/180.0; 809*37da2899SCharles.Forsyth} 810*37da2899SCharles.Forsyth 811*37da2899SCharles.Forsythrad2deg(r: real): real 812*37da2899SCharles.Forsyth{ 813*37da2899SCharles.Forsyth return r*180.0/Pi; 814*37da2899SCharles.Forsyth} 815*37da2899SCharles.Forsyth 816*37da2899SCharles.Forsythsec2rad(s: real): real 817*37da2899SCharles.Forsyth{ 818*37da2899SCharles.Forsyth return deg2rad(s/3600.0); 819*37da2899SCharles.Forsyth} 820*37da2899SCharles.Forsyth 821*37da2899SCharles.Forsythnorm(r: real): real 822*37da2899SCharles.Forsyth{ 823*37da2899SCharles.Forsyth while(r > Pi) 824*37da2899SCharles.Forsyth r -= 2.0*Pi; 825*37da2899SCharles.Forsyth while(r < -Pi) 826*37da2899SCharles.Forsyth r += 2.0*Pi; 827*37da2899SCharles.Forsyth return r; 828*37da2899SCharles.Forsyth} 829*37da2899SCharles.Forsyth 830*37da2899SCharles.Forsythsmall(r: real): int 831*37da2899SCharles.Forsyth{ 832*37da2899SCharles.Forsyth return r > -Epsilon && r < Epsilon; 833*37da2899SCharles.Forsyth} 834*37da2899SCharles.Forsyth 835*37da2899SCharles.Forsythtrunc(r: real): int 836*37da2899SCharles.Forsyth{ 837*37da2899SCharles.Forsyth # down : assumes r >= 0 838*37da2899SCharles.Forsyth i := int r; 839*37da2899SCharles.Forsyth if(real i > r) 840*37da2899SCharles.Forsyth i--; 841*37da2899SCharles.Forsyth return i; 842*37da2899SCharles.Forsyth} 843*37da2899SCharles.Forsyth 844*37da2899SCharles.Forsythabs(x: int): int 845*37da2899SCharles.Forsyth{ 846*37da2899SCharles.Forsyth if(x < 0) 847*37da2899SCharles.Forsyth return -x; 848*37da2899SCharles.Forsyth return x; 849*37da2899SCharles.Forsyth} 850