diff options
Diffstat (limited to 'src')
140 files changed, 10169 insertions, 0 deletions
diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 00000000..338a7f2b --- /dev/null +++ b/src/Makefile @@ -0,0 +1,128 @@ +# Generated automatically from Makefile.in by configure. +# SCCSID--- @(#)Makefile.in 4.8 94/02/27 GIE REL" + +prefix = /usr/local +exec_prefix = $(prefix) + +CC = gcc + +INSTALL = @INSTALL@ + +RANLIB = ranlib + +DEFS = -DHAVE_STRERROR=1 -DHAVE_LIBM=1 + +LIBS = -lm + +PJ_ADDL = + +LIB_DIR_NAME = proj.4 + +bindir = $(exec_prefix)/bin +libdir = $(exec_prefix)/lib +incdir = $(exec_prefix)/include + +LDEF = -DPROJ_LIB=\"$(libdir)/$(LIB_DIR_NAME)\" + +CFLAGS = -g -I./ $(DEFS) $(LDEF) + +SHELL = /bin/sh + +L = libproj.a + +.PRECIOUS: $L + +azimuthal = \ + $L(PJ_aeqd.o) $L(PJ_gnom.o) $L(PJ_laea.o) $L(PJ_mod_ster.o) \ + $L(PJ_nsper.o) $L(PJ_nzmg.o) $L(PJ_ortho.o) $L(PJ_stere.o) + +conic = \ + $L(PJ_aea.o) $L(PJ_bipc.o) $L(PJ_bonne.o) $L(PJ_eqdc.o) \ + $L(PJ_imw_p.o) $L(PJ_lcc.o) $L(PJ_mpoly.o) $L(PJ_poly.o) \ + $L(PJ_rpoly.o) $L(PJ_sconics.o) + +cylinder = \ + $L(PJ_cass.o) $L(PJ_cc.o) $L(PJ_cea.o) $L(PJ_eqc.o) \ + $L(PJ_gall.o) $L(PJ_labrd.o) $L(PJ_lsat.o) $L(PJ_merc.o) \ + $L(PJ_mill.o) $L(PJ_ocea.o) $L(PJ_omerc.o) $L(PJ_somerc.o) \ + $L(PJ_tcc.o) $L(PJ_tcea.o) $L(PJ_tmerc.o) + +misc = \ + $L(PJ_airy.o) $L(PJ_aitoff.o) $L(PJ_august.o) $L(PJ_bacon.o) \ + $L(PJ_chamb.o) $L(PJ_hammer.o) $L(PJ_lagrng.o) $L(PJ_larr.o) \ + $L(PJ_lask.o) $L(PJ_nocol.o) $L(PJ_ob_tran.o) $L(PJ_oea.o) \ + $L(PJ_tpeqd.o) $L(PJ_vandg.o) $L(PJ_vandg2.o) $L(PJ_vandg4.o) \ + $L(PJ_wag7.o) + +pseudo = \ + $L(PJ_boggs.o) $L(PJ_collg.o) $L(PJ_crast.o) $L(PJ_denoy.o) \ + $L(PJ_eck1.o) $L(PJ_eck2.o) $L(PJ_eck3.o) $L(PJ_eck4.o) \ + $L(PJ_eck5.o) $L(PJ_fahey.o) $L(PJ_fouc_s.o) $L(PJ_gins8.o) \ + $L(PJ_gn_sinu.o) $L(PJ_goode.o) $L(PJ_hatano.o) $L(PJ_loxim.o) \ + $L(PJ_mbt_fps.o) $L(PJ_mbtfpp.o) $L(PJ_mbtfpq.o) $L(PJ_moll.o) \ + $L(PJ_nell.o) $L(PJ_nell_h.o) $L(PJ_putp2.o) $L(PJ_putp3.o) \ + $L(PJ_putp4p.o) $L(PJ_putp5.o) $L(PJ_putp6.o) $L(PJ_robin.o) \ + $L(PJ_sts.o) $L(PJ_urm5.o) $L(PJ_urmfps.o) $L(PJ_wag2.o) \ + $L(PJ_wag3.o) $L(PJ_wink1.o) $L(PJ_wink2.o) + +support = \ + $L(aasincos.o) $L(adjlon.o) $L(bch2bps.o) $L(bchgen.o) \ + $L(biveval.o) $L(dmstor.o) $L(mk_cheby.o) $L(pj_auth.o) \ + $L(pj_deriv.o) $L(pj_ell_set.o) $L(pj_ellps.o) $L(pj_errno.o) \ + $L(pj_factors.o) $L(pj_fwd.o) $L(pj_init.o) $L(pj_inv.o) \ + $L(pj_list.o) $L(pj_malloc.o) $L(pj_mlfn.o) $L(pj_msfn.o) \ + $L(pj_open_lib.o) $L(pj_param.o) $L(pj_phi2.o) $L(pj_pr_list.o) \ + $L(pj_qsfn.o) $L(pj_strerrno.o) $L(pj_tsfn.o) $L(pj_units.o) \ + $L(pj_zpoly1.o) $L(rtodms.o) $L(vector1.o) + +LLIST = $(azimuthal) $(conic) $(cylinder) $(misc) $(pseudo) $(support) + +# Second part of export Makefile +# SCCSID--- @(#)Make.2 4.7 95/09/23 GIE REL" + +all: libproj proj geod nad2nad nad2bin + +PROJ.o = proj.o gen_cheb.o p_series.o emess.o + +proj: $(PROJ.o) $L + $(CC) -o $@ $(PROJ.o) $L $(LIBS) + +NAD2NAD.o = nad2nad.o nad_cvt.o nad_init.o nad_intr.o emess.o + +nad2nad: $(NAD2NAD.o) $L + $(CC) -o $@ $(NAD2NAD.o) $L $(LIBS) + +nad2nad: nad_list.h + +nad2bin: nad2bin.o + $(CC) -o $@ nad2bin.o $(LIBS) + +RLIB = $L(pj_release.o) + +libproj: $(RLIB) $(LLIST) $(PJ_ADDL) + $(RANLIB) $L + +GEOD.o = geod.o geod_set.o geod_for.o geod_inv.o emess.o + +geod: $(GEOD.o) $L + $(CC) -o $@ $(GEOD.o) $L $(LIBS) + +install: all + cp proj geod nad2nad $(bindir) + chmod 755 $(bindir)/proj $(bindir)/geod $(bindir)/nad2nad + cp projects.h $(incdir) + chmod 644 $(incdir)/projects.h + cp libproj.a $(libdir) + chmod 644 $(libdir)/libproj.a + $(RANLIB) $(libdir)/libproj.a + +clean: + /bin/rm -f core *.o + +$(GEOD.o): geodesic.h + +$(RLIB) : projects.h pj_list.h + +nad2nad.o geod.o proj.o: emess.h projects.h + +nad2bin.o: projects.h diff --git a/src/Makefile.in b/src/Makefile.in new file mode 100644 index 00000000..8fd9b763 --- /dev/null +++ b/src/Makefile.in @@ -0,0 +1,127 @@ +# SCCSID--- @(#)Makefile.in 4.8 94/02/27 GIE REL" + +prefix = /usr/local +exec_prefix = $(prefix) + +CC = @CC@ + +INSTALL = @INSTALL@ + +RANLIB = @RANLIB@ + +DEFS = @DEFS@ + +LIBS = @LIBS@ + +PJ_ADDL = @PJ_ADDL@ + +LIB_DIR_NAME = @LIB_DIR@ + +bindir = $(exec_prefix)/bin +libdir = $(exec_prefix)/lib +incdir = $(exec_prefix)/include + +LDEF = -DPROJ_LIB=\"$(libdir)/$(LIB_DIR_NAME)\" + +CFLAGS = -O -I./ $(DEFS) $(LDEF) + +SHELL = /bin/sh + +L = libproj.a + +.PRECIOUS: $L + +azimuthal = \ + $L(PJ_aeqd.o) $L(PJ_gnom.o) $L(PJ_laea.o) $L(PJ_mod_ster.o) \ + $L(PJ_nsper.o) $L(PJ_nzmg.o) $L(PJ_ortho.o) $L(PJ_stere.o) + +conic = \ + $L(PJ_aea.o) $L(PJ_bipc.o) $L(PJ_bonne.o) $L(PJ_eqdc.o) \ + $L(PJ_imw_p.o) $L(PJ_lcc.o) $L(PJ_mpoly.o) $L(PJ_poly.o) \ + $L(PJ_rpoly.o) $L(PJ_sconics.o) + +cylinder = \ + $L(PJ_cass.o) $L(PJ_cc.o) $L(PJ_cea.o) $L(PJ_eqc.o) \ + $L(PJ_gall.o) $L(PJ_labrd.o) $L(PJ_lsat.o) $L(PJ_merc.o) \ + $L(PJ_mill.o) $L(PJ_ocea.o) $L(PJ_omerc.o) $L(PJ_somerc.o) \ + $L(PJ_tcc.o) $L(PJ_tcea.o) $L(PJ_tmerc.o) + +misc = \ + $L(PJ_airy.o) $L(PJ_aitoff.o) $L(PJ_august.o) $L(PJ_bacon.o) \ + $L(PJ_chamb.o) $L(PJ_hammer.o) $L(PJ_lagrng.o) $L(PJ_larr.o) \ + $L(PJ_lask.o) $L(PJ_nocol.o) $L(PJ_ob_tran.o) $L(PJ_oea.o) \ + $L(PJ_tpeqd.o) $L(PJ_vandg.o) $L(PJ_vandg2.o) $L(PJ_vandg4.o) \ + $L(PJ_wag7.o) + +pseudo = \ + $L(PJ_boggs.o) $L(PJ_collg.o) $L(PJ_crast.o) $L(PJ_denoy.o) \ + $L(PJ_eck1.o) $L(PJ_eck2.o) $L(PJ_eck3.o) $L(PJ_eck4.o) \ + $L(PJ_eck5.o) $L(PJ_fahey.o) $L(PJ_fouc_s.o) $L(PJ_gins8.o) \ + $L(PJ_gn_sinu.o) $L(PJ_goode.o) $L(PJ_hatano.o) $L(PJ_loxim.o) \ + $L(PJ_mbt_fps.o) $L(PJ_mbtfpp.o) $L(PJ_mbtfpq.o) $L(PJ_moll.o) \ + $L(PJ_nell.o) $L(PJ_nell_h.o) $L(PJ_putp2.o) $L(PJ_putp3.o) \ + $L(PJ_putp4p.o) $L(PJ_putp5.o) $L(PJ_putp6.o) $L(PJ_robin.o) \ + $L(PJ_sts.o) $L(PJ_urm5.o) $L(PJ_urmfps.o) $L(PJ_wag2.o) \ + $L(PJ_wag3.o) $L(PJ_wink1.o) $L(PJ_wink2.o) + +support = \ + $L(aasincos.o) $L(adjlon.o) $L(bch2bps.o) $L(bchgen.o) \ + $L(biveval.o) $L(dmstor.o) $L(mk_cheby.o) $L(pj_auth.o) \ + $L(pj_deriv.o) $L(pj_ell_set.o) $L(pj_ellps.o) $L(pj_errno.o) \ + $L(pj_factors.o) $L(pj_fwd.o) $L(pj_init.o) $L(pj_inv.o) \ + $L(pj_list.o) $L(pj_malloc.o) $L(pj_mlfn.o) $L(pj_msfn.o) \ + $L(pj_open_lib.o) $L(pj_param.o) $L(pj_phi2.o) $L(pj_pr_list.o) \ + $L(pj_qsfn.o) $L(pj_strerrno.o) $L(pj_tsfn.o) $L(pj_units.o) \ + $L(pj_zpoly1.o) $L(rtodms.o) $L(vector1.o) + +LLIST = $(azimuthal) $(conic) $(cylinder) $(misc) $(pseudo) $(support) + +# Second part of export Makefile +# SCCSID--- @(#)Make.2 4.7 95/09/23 GIE REL" + +all: @PROGS@ + +PROJ.o = proj.o gen_cheb.o p_series.o emess.o + +proj: $(PROJ.o) $L + $(CC) -o $@ $(PROJ.o) $L $(LIBS) + +NAD2NAD.o = nad2nad.o nad_cvt.o nad_init.o nad_intr.o emess.o + +nad2nad: $(NAD2NAD.o) $L + $(CC) -o $@ $(NAD2NAD.o) $L $(LIBS) + +nad2nad: nad_list.h + +nad2bin: nad2bin.o + $(CC) -o $@ nad2bin.o $(LIBS) + +RLIB = $L(pj_release.o) + +libproj: $(RLIB) $(LLIST) $(PJ_ADDL) + $(RANLIB) $L + +GEOD.o = geod.o geod_set.o geod_for.o geod_inv.o emess.o + +geod: $(GEOD.o) $L + $(CC) -o $@ $(GEOD.o) $L $(LIBS) + +install: all + cp proj geod nad2nad $(bindir) + chmod 755 $(bindir)/proj $(bindir)/geod $(bindir)/nad2nad + cp projects.h $(incdir) + chmod 644 $(incdir)/projects.h + cp libproj.a $(libdir) + chmod 644 $(libdir)/libproj.a + $(RANLIB) $(libdir)/libproj.a + +clean: + /bin/rm -f core *.o + +$(GEOD.o): geodesic.h + +$(RLIB) : projects.h pj_list.h + +nad2nad.o geod.o proj.o: emess.h projects.h + +nad2bin.o: projects.h diff --git a/src/PJ_aea.c b/src/PJ_aea.c new file mode 100644 index 00000000..6ad5e9f0 --- /dev/null +++ b/src/PJ_aea.c @@ -0,0 +1,131 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_aea.c 4.2 94/03/18 GIE REL"; +#endif +# define EPS10 1.e-10 +# define TOL7 1.e-7 +#define PROJ_PARMS__ \ + double ec; \ + double n; \ + double c; \ + double dd; \ + double n2; \ + double rho0; \ + double rho; \ + double phi1; \ + double phi2; \ + double *en; \ + int ellips; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(aea, "Albers Equal Area") + "\n\tConic Sph&Ell\n\tlat_1= lat_2="; +PROJ_HEAD(leac, "Lambert Equal Area Conic") + "\n\tConic, Sph&Ell\n\tlat_1= south"; +/* determine latitude angle phi-1 */ +# define N_ITER 15 +# define EPSILON 1.0e-7 +# define TOL 1.0e-10 + static double +phi1_(double qs, double Te, double Tone_es) { + int i; + double Phi, sinpi, cospi, con, com, dphi; + + Phi = asin (.5 * qs); + if (Te < EPSILON) + return( Phi ); + i = N_ITER; + do { + sinpi = sin (Phi); + cospi = cos (Phi); + con = Te * sinpi; + com = 1. - con * con; + dphi = .5 * com * com / cospi * (qs / Tone_es - + sinpi / com + .5 / Te * log ((1. - con) / + (1. + con))); + Phi += dphi; + } while (fabs(dphi) > TOL && --i); + return( i ? Phi : HUGE_VAL ); +} +FORWARD(e_forward); /* ellipsoid & spheroid */ + if ((P->rho = P->c - (P->ellips ? P->n * pj_qsfn(sin(lp.phi), + P->e, P->one_es) : P->n2 * sin(lp.phi))) < 0.) F_ERROR + P->rho = P->dd * sqrt(P->rho); + xy.x = P->rho * sin( lp.lam *= P->n ); + xy.y = P->rho0 - P->rho * cos(lp.lam); + return (xy); +} +INVERSE(e_inverse) /* ellipsoid & spheroid */; + if (P->rho = hypot(xy.x, xy.y = P->rho0 - xy.y)) { + if (P->n < 0.) { + P->rho = -P->rho; + xy.x = -xy.x; + xy.y = -xy.y; + } + lp.phi = P->rho / P->dd; + if (P->ellips) { + lp.phi = (P->c - lp.phi * lp.phi) / P->n; + if (fabs(P->ec - fabs(lp.phi)) > TOL7) { + if ((lp.phi = phi1_(lp.phi, P->e, P->one_es)) == HUGE_VAL) + I_ERROR + } else + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + } else if (fabs(lp.phi = (P->c - lp.phi * lp.phi) / P->n2) <= 1.) + lp.phi = asin(lp.phi); + else + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + lp.lam = atan2(xy.x, xy.y) / P->n; + } else { + lp.lam = 0.; + lp.phi = P->n > 0. ? HALFPI : - HALFPI; + } + return (lp); +} +FREEUP; if (P) { if (P->en) pj_dalloc(P->en); pj_dalloc(P); } } + static PJ * +setup(PJ *P) { + double cosphi, sinphi; + int secant; + + if (fabs(P->phi1 + P->phi2) < EPS10) E_ERROR(-21); + P->n = sinphi = sin(P->phi1); + cosphi = cos(P->phi1); + secant = fabs(P->phi1 - P->phi2) >= EPS10; + if (P->ellips = P->es > 0.) { + double ml1, m1; + + if (!(P->en = pj_enfn(P->es))) E_ERROR_0; + m1 = pj_msfn(sinphi, cosphi, P->es); + ml1 = pj_qsfn(sinphi, P->e, P->one_es); + if (secant) { /* secant cone */ + double ml2, m2; + + sinphi = sin(P->phi2); + cosphi = cos(P->phi2); + m2 = pj_msfn(sinphi, cosphi, P->es); + ml2 = pj_qsfn(sinphi, P->e, P->one_es); + P->n = (m1 * m1 - m2 * m2) / (ml2 - ml1); + } + P->ec = 1. - .5 * P->one_es * log((1. - P->e) / + (1. + P->e)) / P->e; + P->c = m1 * m1 + P->n * ml1; + P->dd = 1. / P->n; + P->rho0 = P->dd * sqrt(P->c - P->n * pj_qsfn(sin(P->phi0), + P->e, P->one_es)); + } else { + if (secant) P->n = .5 * (P->n + sin(P->phi2)); + P->n2 = P->n + P->n; + P->c = cosphi * cosphi + P->n2 * sinphi; + P->dd = 1. / P->n; + P->rho0 = P->dd * sqrt(P->c - P->n2 * sin(P->phi0)); + } + P->inv = e_inverse; P->fwd = e_forward; + return P; +} +ENTRY0(aea) + P->phi1 = pj_param(P->params, "rlat_1").f; + P->phi2 = pj_param(P->params, "rlat_2").f; +ENDENTRY(setup(P)) +ENTRY0(leac) + P->phi2 = pj_param(P->params, "rlat_1").f; + P->phi1 = pj_param(P->params, "bsouth").i ? - HALFPI: HALFPI; +ENDENTRY(setup(P)) diff --git a/src/PJ_aeqd.c b/src/PJ_aeqd.c new file mode 100644 index 00000000..95f98722 --- /dev/null +++ b/src/PJ_aeqd.c @@ -0,0 +1,241 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_aeqd.c 4.3 94/11/03 GIE REL"; +#endif +#define EPS10 1.e-10 +#define TOL 1.e-14 +#define PROJ_PARMS__ \ + double sinph0; \ + double cosph0; \ + double *en; \ + double M1; \ + double N1; \ + double Mp; \ + double He; \ + double G; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(aeqd, "Azimuthal Equidistant") "\n\tAzi, Sph&Ell\n\tlat_0 guam"; +#define N_POLE 0 +#define S_POLE 1 +#define EQUIT 2 +#define OBLIQ 3 +FORWARD(e_guam_fwd); /* Guam elliptical */ + double cosphi, sinphi, t; + + cosphi = cos(lp.phi); + sinphi = sin(lp.phi); + t = 1. / sqrt(1. - P->es * sinphi * sinphi); + xy.x = lp.lam * cosphi * t; + xy.y = pj_mlfn(lp.phi, sinphi, cosphi, P->en) - P->M1 + + .5 * lp.lam * lp.lam * cosphi * sinphi * t; + return (xy); +} +FORWARD(e_forward); /* elliptical */ + double coslam, cosphi, sinphi, rho, s, H, H2, c, Az, t, ct, st, cA, sA; + + coslam = cos(lp.lam); + cosphi = cos(lp.phi); + sinphi = sin(lp.phi); + switch (P->mode) { + case N_POLE: + coslam = - coslam; + case S_POLE: + xy.x = (rho = fabs(P->Mp - pj_mlfn(lp.phi, sinphi, cosphi, P->en))) * + sin(lp.lam); + xy.y = rho * coslam; + break; + case EQUIT: + case OBLIQ: + if (fabs(lp.lam) < EPS10 && fabs(lp.phi - P->phi0) < EPS10) { + xy.x = xy.y = 0.; + break; + } + t = atan2(P->one_es * sinphi + P->es * P->N1 * P->sinph0 * + sqrt(1. - P->es * sinphi * sinphi), cosphi); + ct = cos(t); st = sin(t); + Az = atan2(sin(lp.lam) * ct, P->cosph0 * st - P->sinph0 * coslam * ct); + cA = cos(Az); sA = sin(Az); + s = aasin( fabs(sA) < TOL ? + (P->cosph0 * st - P->sinph0 * coslam * ct) / cA : + sin(lp.lam) * ct / sA ); + H = P->He * cA; + H2 = H * H; + c = P->N1 * s * (1. + s * s * (- H2 * (1. - H2)/6. + + s * ( P->G * H * (1. - 2. * H2 * H2) / 8. + + s * ((H2 * (4. - 7. * H2) - 3. * P->G * P->G * (1. - 7. * H2)) / + 120. - s * P->G * H / 48.)))); + xy.x = c * sA; + xy.y = c * cA; + break; + } + return (xy); +} +FORWARD(s_forward); /* spherical */ + double coslam, cosphi, sinphi; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + switch (P->mode) { + case EQUIT: + xy.y = cosphi * coslam; + goto oblcon; + case OBLIQ: + xy.y = P->sinph0 * sinphi + P->cosph0 * cosphi * coslam; +oblcon: + if (fabs(fabs(xy.y) - 1.) < TOL) + if (xy.y < 0.) + F_ERROR + else + xy.x = xy.y = 0.; + else { + xy.y = acos(xy.y); + xy.y /= sin(xy.y); + xy.x = xy.y * cosphi * sin(lp.lam); + xy.y *= (P->mode == EQUIT) ? sinphi : + P->cosph0 * sinphi - P->sinph0 * cosphi * coslam; + } + break; + case N_POLE: + lp.phi = -lp.phi; + coslam = -coslam; + case S_POLE: + if (fabs(lp.phi - HALFPI) < EPS10) F_ERROR; + xy.x = (xy.y = (HALFPI + lp.phi)) * sin(lp.lam); + xy.y *= coslam; + break; + } + return (xy); +} +INVERSE(e_guam_inv); /* Guam elliptical */ + double x2, t; + int i; + + x2 = 0.5 * xy.x * xy.x; + lp.phi = P->phi0; + for (i = 0; i < 3; ++i) { + t = P->e * sin(lp.phi); + lp.phi = pj_inv_mlfn(P->M1 + xy.y - + x2 * tan(lp.phi) * (t = sqrt(1. - t * t)), P->es, P->en); + } + lp.lam = xy.x * t / cos(lp.phi); + return (lp); +} +INVERSE(e_inverse); /* elliptical */ + double c, Az, cosAz, A, B, D, E, F, psi, t; + int i; + + if ((c = hypot(xy.x, xy.y)) < EPS10) { + lp.phi = P->phi0; + lp.lam = 0.; + return (lp); + } + if (P->mode == OBLIQ || P->mode == EQUIT) { + cosAz = cos(Az = atan2(xy.x, xy.y)); + t = P->cosph0 * cosAz; + B = P->es * t / P->one_es; + A = - B * t; + B *= 3. * (1. - A) * P->sinph0; + D = c / P->N1; + E = D * (1. - D * D * (A * (1. + A) / 6. + B * (1. + 3.*A) * D / 24.)); + F = 1. - E * E * (A / 2. + B * E / 6.); + psi = aasin(P->sinph0 * cos(E) + t * sin(E)); + lp.lam = aasin(sin(Az) * sin(E) / cos(psi)); + if ((t = fabs(psi)) < EPS10) + lp.phi = 0.; + else if (fabs(t - HALFPI) < 0.) + lp.phi = HALFPI; + else + lp.phi = atan((1. - P->es * F * P->sinph0 / sin(psi)) * tan(psi) / + P->one_es); + } else { /* Polar */ + lp.phi = pj_inv_mlfn(P->mode == N_POLE ? P->Mp - c : P->Mp + c, + P->es, P->en); + lp.lam = atan2(xy.x, P->mode == N_POLE ? -xy.y : xy.y); + } + return (lp); +} +INVERSE(s_inverse); /* spherical */ + double cosc, c_rh, sinc; + + if ((c_rh = hypot(xy.x, xy.y)) > PI) { + if (c_rh - EPS10 > PI) I_ERROR; + c_rh = PI; + } else if (c_rh < EPS10) { + lp.phi = P->phi0; + lp.lam = 0.; + return (lp); + } + if (P->mode == OBLIQ || P->mode == EQUIT) { + sinc = sin(c_rh); + cosc = cos(c_rh); + if (P->mode == EQUIT) { + lp.phi = aasin(xy.y * sinc / c_rh); + xy.x *= sinc; + xy.y = cosc * c_rh; + } else { + lp.phi = aasin(cosc * P->sinph0 + xy.y * sinc * P->cosph0 / + c_rh); + xy.y = (cosc - P->sinph0 * sin(lp.phi)) * c_rh; + xy.x *= sinc * P->cosph0; + } + lp.lam = xy.y == 0. ? 0. : atan2(xy.x, xy.y); + } else if (P->mode == N_POLE) { + lp.phi = HALFPI - c_rh; + lp.lam = atan2(xy.x, -xy.y); + } else { + lp.phi = c_rh - HALFPI; + lp.lam = atan2(xy.x, xy.y); + } + return (lp); +} +FREEUP; + if (P) { + if (P->en) + pj_dalloc(P->en); + pj_dalloc(P); + } +} +ENTRY1(aeqd, en) + P->phi0 = pj_param(P->params, "rlat_0").f; + if (fabs(fabs(P->phi0) - HALFPI) < EPS10) { + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + P->sinph0 = P->phi0 < 0. ? -1. : 1.; + P->cosph0 = 0.; + } else if (fabs(P->phi0) < EPS10) { + P->mode = EQUIT; + P->sinph0 = 0.; + P->cosph0 = 1.; + } else { + P->mode = OBLIQ; + P->sinph0 = sin(P->phi0); + P->cosph0 = cos(P->phi0); + } + if (! P->es) { + P->inv = s_inverse; P->fwd = s_forward; + } else { + if (!(P->en = pj_enfn(P->es))) E_ERROR_0; + if (pj_param(P->params, "bguam").i) { + P->M1 = pj_mlfn(P->phi0, P->sinph0, P->cosph0, P->en); + P->inv = e_guam_inv; P->fwd = e_guam_fwd; + } else { + switch (P->mode) { + case N_POLE: + P->Mp = pj_mlfn(HALFPI, 1., 0., P->en); + break; + case S_POLE: + P->Mp = pj_mlfn(-HALFPI, -1., 0., P->en); + break; + case EQUIT: + case OBLIQ: + P->inv = e_inverse; P->fwd = e_forward; + P->N1 = 1. / sqrt(1. - P->es * P->sinph0 * P->sinph0); + P->G = P->sinph0 * (P->He = P->e / sqrt(P->one_es)); + P->He *= P->cosph0; + break; + } + P->inv = e_inverse; P->fwd = e_forward; + } + } +ENDENTRY(P) diff --git a/src/PJ_airy.c b/src/PJ_airy.c new file mode 100644 index 00000000..52bce088 --- /dev/null +++ b/src/PJ_airy.c @@ -0,0 +1,94 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_airy.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double p_halfpi; \ + double sinph0; \ + double cosph0; \ + double Cb; \ + int mode; \ + int no_cut; /* do not cut at hemisphere limit */ +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(airy, "Airy") "\n\tMisc Sph, no inv.\n\tno_cut lat_b="; +# define EPS 1.e-10 +# define N_POLE 0 +# define S_POLE 1 +# define EQUIT 2 +# define OBLIQ 3 +FORWARD(s_forward); /* spheroid */ + double sinlam, coslam, cosphi, sinphi, t, s, Krho, cosz; + + sinlam = sin(lp.lam); + coslam = cos(lp.lam); + switch (P->mode) { + case EQUIT: + case OBLIQ: + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + cosz = cosphi * coslam; + if (P->mode == OBLIQ) + cosz = P->sinph0 * sinphi + P->cosph0 * cosz; + if (!P->no_cut && cosz < -EPS) + F_ERROR; + if (fabs(s = 1. - cosz) > EPS) { + t = 0.5 * (1. + cosz); + Krho = -log(t)/s - P->Cb / t; + } else + Krho = 0.5 - P->Cb; + xy.x = Krho * cosphi * sinlam; + if (P->mode == OBLIQ) + xy.y = Krho * (P->cosph0 * sinphi - + P->sinph0 * cosphi * coslam); + else + xy.y = Krho * sinphi; + break; + case S_POLE: + case N_POLE: + lp.phi = fabs(P->p_halfpi - lp.phi); + if (!P->no_cut && (lp.phi - EPS) > HALFPI) + F_ERROR; + if ((lp.phi *= 0.5) > EPS) { + t = tan(lp.phi); + Krho = -2.*(log(cos(lp.phi)) / t + t * P->Cb); + xy.x = Krho * sinlam; + xy.y = Krho * coslam; + if (P->mode == N_POLE) + xy.y = -xy.y; + } else + xy.x = xy.y = 0.; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(airy) + double beta; + + P->no_cut = pj_param(P->params, "bno_cut").i; + beta = 0.5 * (HALFPI - pj_param(P->params, "rlat_b").f); + if (fabs(beta) < EPS) + P->Cb = -0.5; + else { + P->Cb = 1./tan(beta); + P->Cb *= P->Cb * log(cos(beta)); + } + if (fabs(fabs(P->phi0) - HALFPI) < EPS) + if (P->phi0 < 0.) { + P->p_halfpi = -HALFPI; + P->mode = S_POLE; + } else { + P->p_halfpi = HALFPI; + P->mode = N_POLE; + } + else { + if (fabs(P->phi0) < EPS) + P->mode = EQUIT; + else { + P->mode = OBLIQ; + P->sinph0 = sin(P->phi0); + P->cosph0 = cos(P->phi0); + } + } + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_aitoff.c b/src/PJ_aitoff.c new file mode 100644 index 00000000..37e89a81 --- /dev/null +++ b/src/PJ_aitoff.c @@ -0,0 +1,43 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_aitoff.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double cosphi1; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(aitoff, "Aitoff") "\n\tMisc Sph"; +PROJ_HEAD(wintri, "Winkel Tripel") "\n\tMisc Sph\n\tlat_1"; +FORWARD(s_forward); /* spheroid */ + double c, d; + + if (d = acos(cos(lp.phi) * cos(c = 0.5 * lp.lam))) { /* basic Aitoff */ + xy.x = 2. * d * cos(lp.phi) * sin(c) * (xy.y = 1. / sin(d)); + xy.y *= d * sin(lp.phi); + } else + xy.x = xy.y = 0.; + if (P->mode) { /* Winkel Tripel */ + xy.x = (xy.x + lp.lam * P->cosphi1) * 0.5; + xy.y = (xy.y + lp.phi) * 0.5; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->inv = 0; + P->fwd = s_forward; + P->es = 0.; + return P; +} +ENTRY0(aitoff) + P->mode = 0; +ENDENTRY(setup(P)) +ENTRY0(wintri) + P->mode = 1; + if (pj_param(P->params, "tlat_1").i) + if ((P->cosphi1 = cos(pj_param(P->params, "rlat_1").f)) == 0.) + E_ERROR(-22) + else /* 50d28' or acos(2/pi) */ + P->cosphi1 = 0.636619772367581343; +ENDENTRY(setup(P)) diff --git a/src/PJ_august.c b/src/PJ_august.c new file mode 100644 index 00000000..ca870b2f --- /dev/null +++ b/src/PJ_august.c @@ -0,0 +1,21 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_august.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(august, "August Epicycloidal") "\n\tMisc Sph, no inv."; +#define M 1.333333333333333 +FORWARD(s_forward); /* spheroid */ + double t, c1, c, x1, x12, y1, y12; + + t = tan(.5 * lp.phi); + c1 = sqrt(1. - t * t); + c = 1. + c1 * cos(lp.lam *= .5); + x1 = sin(lp.lam) * c1 / c; + y1 = t / c; + xy.x = M * x1 * (3. + (x12 = x1 * x1) - 3. * (y12 = y1 * y1)); + xy.y = M * y1 * (3. + 3. * x12 - y12); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(august) P->inv = 0; P->fwd = s_forward; P->es = 0.; ENDENTRY(P) diff --git a/src/PJ_bacon.c b/src/PJ_bacon.c new file mode 100644 index 00000000..ab785d2d --- /dev/null +++ b/src/PJ_bacon.c @@ -0,0 +1,44 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_bacon.c 4.1 94/02/15 GIE REL"; +#endif +# define HLFPI2 2.46740110027233965467 +# define EPS 1e-10 +#define PROJ_PARMS__ \ + int bacn; \ + int ortl; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(apian, "Apian Globular I") "\n\tMisc Sph, no inv."; +PROJ_HEAD(ortel, "Ortelius Oval") "\n\tMisc Sph, no inv."; +PROJ_HEAD(bacon, "Bacon Globular") "\n\tMisc Sph, no inv."; +FORWARD(s_forward); /* spheroid */ + double ax, f; + + xy.y = P->bacn ? HALFPI * sin(lp.phi) : lp.phi; + if ((ax = fabs(lp.lam)) >= EPS) { + if (P->ortl && ax >= HALFPI) + xy.x = sqrt(HLFPI2 - lp.phi * lp.phi + EPS) + ax - HALFPI; + else { + f = 0.5 * (HLFPI2 / ax + ax); + xy.x = ax - f + sqrt(f * f - xy.y * xy.y); + } + if (lp.lam < 0.) xy.x = - xy.x; + } else + xy.x = 0.; + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(bacon) + P->bacn = 1; + P->ortl = 0; + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) +ENTRY0(apian) + P->bacn = P->ortl = 0; + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) +ENTRY0(ortel) + P->bacn = 0; + P->ortl = 1; + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_bipc.c b/src/PJ_bipc.c new file mode 100644 index 00000000..dd3fae8d --- /dev/null +++ b/src/PJ_bipc.c @@ -0,0 +1,135 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_bipc.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + int noskew; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(bipc, "Bipolar conic of western hemisphere") + "\n\tConic Sph."; +# define EPS 1e-10 +# define EPS10 1e-10 +# define ONEEPS 1.000000001 +# define NITER 10 +# define lamB -.34894976726250681539 +# define n .63055844881274687180 +# define F 1.89724742567461030582 +# define Azab .81650043674686363166 +# define Azba 1.82261843856185925133 +# define T 1.27246578267089012270 +# define rhoc 1.20709121521568721927 +# define cAzc .69691523038678375519 +# define sAzc .71715351331143607555 +# define C45 .70710678118654752469 +# define S45 .70710678118654752410 +# define C20 .93969262078590838411 +# define S20 -.34202014332566873287 +# define R110 1.91986217719376253360 +# define R104 1.81514242207410275904 +FORWARD(s_forward); /* spheroid */ + double cphi, sphi, tphi, t, al, Az, z, Av, cdlam, sdlam, r; + int tag; + + cphi = cos(lp.phi); + sphi = sin(lp.phi); + cdlam = cos(sdlam = lamB - lp.lam); + sdlam = sin(sdlam); + if (fabs(fabs(lp.phi) - HALFPI) < EPS10) { + Az = lp.phi < 0. ? PI : 0.; + tphi = HUGE_VAL; + } else { + tphi = sphi / cphi; + Az = atan2(sdlam , C45 * (tphi - cdlam)); + } + if (tag = (Az > Azba)) { + cdlam = cos(sdlam = lp.lam + R110); + sdlam = sin(sdlam); + z = S20 * sphi + C20 * cphi * cdlam; + if (fabs(z) > 1.) { + if (fabs(z) > ONEEPS) F_ERROR + else z = z < 0. ? -1. : 1.; + } else + z = acos(z); + if (tphi != HUGE_VAL) + Az = atan2(sdlam, (C20 * tphi - S20 * cdlam)); + Av = Azab; + xy.y = rhoc; + } else { + z = S45 * (sphi + cphi * cdlam); + if (fabs(z) > 1.) { + if (fabs(z) > ONEEPS) F_ERROR + else z = z < 0. ? -1. : 1.; + } else + z = acos(z); + Av = Azba; + xy.y = -rhoc; + } + if (z < 0.) F_ERROR; + r = F * (t = pow(tan(.5 * z), n)); + if ((al = .5 * (R104 - z)) < 0.) F_ERROR; + al = (t + pow(al, n)) / T; + if (fabs(al) > 1.) { + if (fabs(al) > ONEEPS) F_ERROR + else al = al < 0. ? -1. : 1.; + } else + al = acos(al); + if (fabs(t = n * (Av - Az)) < al) + r /= cos(al + (tag ? t : -t)); + xy.x = r * sin(t); + xy.y += (tag ? -r : r) * cos(t); + if (P->noskew) { + t = xy.x; + xy.x = -xy.x * cAzc - xy.y * sAzc; + xy.y = -xy.y * cAzc + t * sAzc; + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t, r, rp, rl, al, z, fAz, Az, s, c, Av; + int neg, i; + + if (P->noskew) { + t = xy.x; + xy.x = -xy.x * cAzc + xy.y * sAzc; + xy.y = -xy.y * cAzc - t * sAzc; + } + if (neg = (xy.x < 0.)) { + xy.y = rhoc - xy.y; + s = S20; + c = C20; + Av = Azab; + } else { + xy.y += rhoc; + s = S45; + c = C45; + Av = Azba; + } + rl = rp = r = hypot(xy.x, xy.y); + fAz = fabs(Az = atan2(xy.x, xy.y)); + for (i = NITER; i ; --i) { + z = 2. * atan(pow(r / F,1 / n)); + al = acos((pow(tan(.5 * z), n) + + pow(tan(.5 * (R104 - z)), n)) / T); + if (fAz < al) + r = rp * cos(al + (neg ? Az : -Az)); + if (fabs(rl - r) < EPS) + break; + rl = r; + } + if (! i) I_ERROR; + Az = Av - Az / n; + lp.phi = asin(s * cos(z) + c * sin(z) * cos(Az)); + lp.lam = atan2(sin(Az), c / tan(z) - s * cos(Az)); + if (neg) + lp.lam -= R110; + else + lp.lam = lamB - lp.lam; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(bipc) + P->noskew = pj_param(P->params, "bns").i; + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_boggs.c b/src/PJ_boggs.c new file mode 100644 index 00000000..bcb806ec --- /dev/null +++ b/src/PJ_boggs.c @@ -0,0 +1,35 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_boggs.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(boggs, "Boggs Eumorphic") "\n\tPCyl., no inv., Sph."; +# define NITER 20 +# define EPS 1e-7 +# define ONETOL 1.000001 +# define FXC 2.00276 +# define FXC2 1.11072 +# define FYC 0.49931 +# define FYC2 1.41421356237309504880 +FORWARD(s_forward); /* spheroid */ + double theta, th1, c; + int i; + + theta = lp.phi; + if (fabs(fabs(lp.phi) - HALFPI) < EPS) + xy.x = 0.; + else { + c = sin(theta) * PI; + for (i = NITER; i; --i) { + theta -= th1 = (theta + sin(theta) - c) / + (1. + cos(theta)); + if (fabs(th1) < EPS) break; + } + theta *= 0.5; + xy.x = FXC * lp.lam / (1. / cos(lp.phi) + FXC2 / cos(theta)); + } + xy.y = FYC * (lp.phi + FYC2 * sin(theta)); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(boggs) P->es = 0.; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_bonne.c b/src/PJ_bonne.c new file mode 100644 index 00000000..2371b2ce --- /dev/null +++ b/src/PJ_bonne.c @@ -0,0 +1,88 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_bonne.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phi1; \ + double cphi1; \ + double am1; \ + double m1; \ + double *en; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(bonne, "Bonne (Werner lat_1=90)") + "\n\tConic Sph&Ell\n\tlat_1="; +#define EPS10 1e-10 +FORWARD(e_forward); /* ellipsoid */ + double rh, E, c; + + rh = P->am1 + P->m1 - pj_mlfn(lp.phi, E = sin(lp.phi), c = cos(lp.phi), P->en); + E = c * lp.lam / (rh * sqrt(1. - P->es * E * E)); + xy.x = rh * sin(E); + xy.y = P->am1 - rh * cos(E); + return (xy); +} +FORWARD(s_forward); /* spheroid */ + double E, rh; + + rh = P->cphi1 + P->phi1 - lp.phi; + if (fabs(rh) > EPS10) { + xy.x = rh * sin(E = lp.lam * cos(lp.phi) / rh); + xy.y = P->cphi1 - rh * cos(E); + } else + xy.x = xy.y = 0.; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double rh; + + rh = hypot(xy.x, xy.y = P->cphi1 - xy.y); + lp.phi = P->cphi1 + P->phi1 - rh; + if (fabs(lp.phi) > HALFPI) I_ERROR; + if (fabs(fabs(lp.phi) - HALFPI) <= EPS10) + lp.lam = 0.; + else + lp.lam = rh * atan2(xy.x, xy.y) / cos(lp.phi); + return (lp); +} +INVERSE(e_inverse); /* ellipsoid */ + double s, rh; + + rh = hypot(xy.x, xy.y = P->am1 - xy.y); + lp.phi = pj_inv_mlfn(P->am1 + P->m1 - rh, P->es, P->en); + if ((s = fabs(lp.phi)) < HALFPI) { + s = sin(lp.phi); + lp.lam = rh * atan2(xy.x, xy.y) * + sqrt(1. - P->es * s * s) / cos(lp.phi); + } else if (fabs(s - HALFPI) <= EPS10) + lp.lam = 0.; + else I_ERROR; + return (lp); +} +FREEUP; + if (P) { + if (P->en) + pj_dalloc(P->en); + pj_dalloc(P); + } +} +ENTRY1(bonne, en) + double c; + + P->phi1 = pj_param(P->params, "rlat_1").f; + if (fabs(P->phi1) < EPS10) E_ERROR(-23); + if (P->es) { + P->en = pj_enfn(P->es); + P->m1 = pj_mlfn(P->phi1, P->am1 = sin(P->phi1), + c = cos(P->phi1), P->en); + P->am1 = c / (sqrt(1. - P->es * P->am1 * P->am1) * P->am1); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + if (fabs(P->phi1) + EPS10 >= HALFPI) + P->cphi1 = 0.; + else + P->cphi1 = 1. / tan(P->phi1); + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_cass.c b/src/PJ_cass.c new file mode 100644 index 00000000..f4ed2e19 --- /dev/null +++ b/src/PJ_cass.c @@ -0,0 +1,82 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_cass.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double m0; \ + double n; \ + double t; \ + double a1; \ + double c; \ + double r; \ + double dd; \ + double d2; \ + double a2; \ + double tn; \ + double *en; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(cass, "Cassini") "\n\tCyl, Sph&Ell"; +# define EPS10 1e-10 +# define C1 .16666666666666666666 +# define C2 .00833333333333333333 +# define C3 .04166666666666666666 +# define C4 .33333333333333333333 +# define C5 .06666666666666666666 +FORWARD(e_forward); /* ellipsoid */ + xy.y = pj_mlfn(lp.phi, P->n = sin(lp.phi), P->c = cos(lp.phi), P->en); + P->n = 1./sqrt(1. - P->es * P->n * P->n); + P->tn = tan(lp.phi); P->t = P->tn * P->tn; + P->a1 = lp.lam * P->c; + P->c *= P->es * P->c / (1 - P->es); + P->a2 = P->a1 * P->a1; + xy.x = P->n * P->a1 * (1. - P->a2 * P->t * + (C1 - (8. - P->t + 8. * P->c) * P->a2 * C2)); + xy.y -= P->m0 - P->n * P->tn * P->a2 * + (.5 + (5. - P->t + 6. * P->c) * P->a2 * C3); + return (xy); +} +FORWARD(s_forward); /* spheroid */ + xy.x = asin(cos(lp.phi) * sin(lp.lam)); + xy.y = atan2(tan(lp.phi) , cos(lp.lam)) - P->phi0; + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + double ph1; + + ph1 = pj_inv_mlfn(P->m0 + xy.y, P->es, P->en); + P->tn = tan(ph1); P->t = P->tn * P->tn; + P->n = sin(ph1); + P->r = 1. / (1. - P->es * P->n * P->n); + P->n = sqrt(P->r); + P->r *= (1. - P->es) * P->n; + P->dd = xy.x / P->n; + P->d2 = P->dd * P->dd; + lp.phi = ph1 - (P->n * P->tn / P->r) * P->d2 * + (.5 - (1. + 3. * P->t) * P->d2 * C3); + lp.lam = P->dd * (1. + P->t * P->d2 * + (-C4 + (1. + 3. * P->t) * P->d2 * C5)) / cos(ph1); + return (lp); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = asin(sin(P->dd = xy.y + P->phi0) * cos(xy.x)); + lp.lam = atan2(tan(xy.x), cos(P->dd)); + return (lp); +} +FREEUP; + if (P) { + if (P->en) + pj_dalloc(P->en); + pj_dalloc(P); + } +} +ENTRY1(cass, en) + if (P->es) { + if (!(P->en = pj_enfn(P->es))) E_ERROR_0; + P->m0 = pj_mlfn(P->phi0, sin(P->phi0), cos(P->phi0), P->en); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_cc.c b/src/PJ_cc.c new file mode 100644 index 00000000..b578c476 --- /dev/null +++ b/src/PJ_cc.c @@ -0,0 +1,22 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_cc.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double ap; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(cc, "Central Cylindrical") "\n\tCyl, Sph"; +#define EPS10 1.e-10 +FORWARD(s_forward); /* spheroid */ + if (fabs(fabs(lp.phi) - HALFPI) <= EPS10) F_ERROR; + xy.x = lp.lam; + xy.y = tan(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = atan(xy.y); + lp.lam = xy.x; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(cc) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_cea.c b/src/PJ_cea.c new file mode 100644 index 00000000..4286d9a5 --- /dev/null +++ b/src/PJ_cea.c @@ -0,0 +1,64 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_cea.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double qp; \ + double *apa; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(cea, "Equal Area Cylindrical") "\n\tCyl, Sph&Ell\n\tlat_ts="; +# define EPS 1e-10 +FORWARD(e_forward); /* spheroid */ + xy.x = P->k0 * lp.lam; + xy.y = .5 * pj_qsfn(sin(lp.phi), P->e, P->one_es) / P->k0; + return (xy); +} +FORWARD(s_forward); /* spheroid */ + xy.x = P->k0 * lp.lam; + xy.y = sin(lp.phi) / P->k0; + return (xy); +} +INVERSE(e_inverse); /* spheroid */ + lp.phi = pj_authlat(asin( 2. * xy.y * P->k0 / P->qp), P->apa); + lp.lam = xy.x / P->k0; + return (lp); +} +INVERSE(s_inverse); /* spheroid */ + double t; + + if ((t = fabs(xy.y *= P->k0)) - EPS <= 1.) { + if (t >= 1.) + lp.phi = xy.y < 0. ? -HALFPI : HALFPI; + else + lp.phi = asin(xy.y); + lp.lam = xy.x / P->k0; + } else I_ERROR; + return (lp); +} +FREEUP; + if (P) { + if (P->apa) + pj_dalloc(P->apa); + pj_dalloc(P); + } +} +ENTRY1(cea, apa) + double t; + + if (pj_param(P->params, "tlat_ts").i && + (P->k0 = cos(t = pj_param(P->params, "rlat_ts").f)) < 0.) E_ERROR(-24) + else + t = 0.; + if (P->es) { + t = sin(t); + P->k0 /= sqrt(1. - P->es * t * t); + P->e = sqrt(P->es); + if (!(P->apa = pj_authset(P->es))) E_ERROR_0; + P->qp = pj_qsfn(1., P->e, P->one_es); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_chamb.c b/src/PJ_chamb.c new file mode 100644 index 00000000..8526e480 --- /dev/null +++ b/src/PJ_chamb.c @@ -0,0 +1,115 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_chamb.c 4.1 94/02/15 GIE REL"; +#endif +typedef struct { double r, Az; } VECT; +#define PROJ_PARMS__ \ + struct { /* control point data */ \ + double phi, lam; \ + double cosphi, sinphi; \ + VECT v; \ + XY p; \ + double Az; \ + } c[3]; \ + XY p; \ + double beta_0, beta_1, beta_2; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(chamb, "Chamberlin Trimetric") "\n\tMisc Sph, no inv." +"\n\tlat_1= lon_1= lat_2= lon_2= lat_3= lon_3="; +#include <stdio.h> +#define THIRD 0.333333333333333333 +#define TOL 1e-9 + static VECT /* distance and azimuth from point 1 to point 2 */ +vect(double dphi, double c1, double s1, double c2, double s2, double dlam) { + VECT v; + double cdl, dp, dl; + + cdl = cos(dlam); + if (fabs(dphi) > 1. || fabs(dlam) > 1.) + v.r = aacos(s1 * s2 + c1 * c2 * cdl); + else { /* more accurate for smaller distances */ + dp = sin(.5 * dphi); + dl = sin(.5 * dlam); + v.r = 2. * aasin(sqrt(dp * dp + c1 * c2 * dl * dl)); + } + if (fabs(v.r) > TOL) + v.Az = atan2(c2 * sin(dlam), c1 * s2 - s1 * c2 * cdl); + else + v.r = v.Az = 0.; + return v; +} + static double /* law of cosines */ +lc(double b,double c,double a) { + return aacos(.5 * (b * b + c * c - a * a) / (b * c)); +} +FORWARD(s_forward); /* spheroid */ + double sinphi, cosphi, a; + VECT v[3]; + int i, j; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + for (i = 0; i < 3; ++i) { /* dist/azimiths from control */ + v[i] = vect(lp.phi - P->c[i].phi, P->c[i].cosphi, P->c[i].sinphi, + cosphi, sinphi, lp.lam - P->c[i].lam); + if ( ! v[i].r) + break; + v[i].Az = adjlon(v[i].Az - P->c[i].v.Az); + } + if (i < 3) /* current point at control point */ + xy = P->c[i].p; + else { /* point mean of intersepts */ + xy = P->p; + for (i = 0; i < 3; ++i) { + j = i == 2 ? 0 : i + 1; + a = lc(P->c[i].v.r, v[i].r, v[j].r); + if (v[i].Az < 0.) + a = -a; + if (! i) { /* coord comp unique to each arc */ + xy.x += v[i].r * cos(a); + xy.y -= v[i].r * sin(a); + } else if (i == 1) { + a = P->beta_1 - a; + xy.x -= v[i].r * cos(a); + xy.y -= v[i].r * sin(a); + } else { + a = P->beta_2 - a; + xy.x += v[i].r * cos(a); + xy.y += v[i].r * sin(a); + } + } + xy.x *= THIRD; /* mean of arc intercepts */ + xy.y *= THIRD; + } + return xy; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(chamb) + int i, j; + char line[10]; + + for (i = 0; i < 3; ++i) { /* get control point locations */ + (void)sprintf(line, "rlat_%d", i+1); + P->c[i].phi = pj_param(P->params, line).f; + (void)sprintf(line, "rlon_%d", i+1); + P->c[i].lam = pj_param(P->params, line).f; + P->c[i].lam = adjlon(P->c[i].lam - P->lam0); + P->c[i].cosphi = cos(P->c[i].phi); + P->c[i].sinphi = sin(P->c[i].phi); + } + for (i = 0; i < 3; ++i) { /* inter ctl pt. distances and azimuths */ + j = i == 2 ? 0 : i + 1; + P->c[i].v = vect(P->c[j].phi - P->c[i].phi, P->c[i].cosphi, P->c[i].sinphi, + P->c[j].cosphi, P->c[j].sinphi, P->c[j].lam - P->c[i].lam); + if (! P->c[i].v.r) E_ERROR(-25); + /* co-linearity problem ignored for now */ + } + P->beta_0 = lc(P->c[0].v.r, P->c[2].v.r, P->c[1].v.r); + P->beta_1 = lc(P->c[0].v.r, P->c[1].v.r, P->c[2].v.r); + P->beta_2 = PI - P->beta_0; + P->p.y = 2. * (P->c[0].p.y = P->c[1].p.y = P->c[2].v.r * sin(P->beta_0)); + P->c[2].p.y = 0.; + P->c[0].p.x = - (P->c[1].p.x = 0.5 * P->c[0].v.r); + P->p.x = P->c[2].p.x = P->c[0].p.x + P->c[2].v.r * cos(P->beta_0); + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_collg.c b/src/PJ_collg.c new file mode 100644 index 00000000..9bcc24fa --- /dev/null +++ b/src/PJ_collg.c @@ -0,0 +1,32 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_collg.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(collg, "Collignon") "\n\tPCyl, Sph."; +#define FXC 1.12837916709551257390 +#define FYC 1.77245385090551602729 +#define ONEEPS 1.0000001 +FORWARD(s_forward); /* spheroid */ + if ((xy.y = 1. - sin(lp.phi)) <= 0.) + xy.y = 0.; + else + xy.y = sqrt(xy.y); + xy.x = FXC * lp.lam * xy.y; + xy.y = FYC * (1. - xy.y); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / FYC - 1.; + if (fabs(lp.phi = 1. - lp.phi * lp.phi) < 1.) + lp.phi = asin(lp.phi); + else if (fabs(lp.phi) > ONEEPS) I_ERROR + else lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + if ((lp.lam = 1. - sin(lp.phi)) <= 0.) + lp.lam = 0.; + else + lp.lam = xy.x / (FXC * sqrt(lp.lam)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(collg) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_crast.c b/src/PJ_crast.c new file mode 100644 index 00000000..a72203e8 --- /dev/null +++ b/src/PJ_crast.c @@ -0,0 +1,25 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_crast.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(crast, "Craster Parabolic (Putnins P4)") +"\n\tPCyl., Sph."; +#define XM 0.97720502380583984317 +#define RXM 1.02332670794648848847 +#define YM 3.06998012383946546542 +#define RYM 0.32573500793527994772 +#define THIRD 0.333333333333333333 +FORWARD(s_forward); /* spheroid */ + lp.phi *= THIRD; + xy.x = XM * lp.lam * (2. * cos(lp.phi + lp.phi) - 1.); + xy.y = YM * sin(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = 3. * asin(xy.y * RYM); + lp.lam = xy.x * RXM / (2. * cos((lp.phi + lp.phi) * THIRD) - 1); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(crast) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_denoy.c b/src/PJ_denoy.c new file mode 100644 index 00000000..335eac1c --- /dev/null +++ b/src/PJ_denoy.c @@ -0,0 +1,21 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_denoy.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(denoy, "Denoyer Semi-Elliptical") "\n\tPCyl., no inv., Sph."; +#define C0 0.95 +#define C1 -.08333333333333333333 +#define C3 .00166666666666666666 +#define D1 0.9 +#define D5 0.03 +FORWARD(s_forward); /* spheroid */ + xy.y = lp.phi; + xy.x = lp.lam; + lp.lam = fabs(lp.lam); + xy.x *= cos((C0 + lp.lam * (C1 + lp.lam * lp.lam * C3)) * + (lp.phi * (D1 + D5 * lp.phi * lp.phi * lp.phi * lp.phi))); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(denoy) P->es = 0.; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_eck1.c b/src/PJ_eck1.c new file mode 100644 index 00000000..18524246 --- /dev/null +++ b/src/PJ_eck1.c @@ -0,0 +1,22 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eck1.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(eck1, "Eckert I") "\n\tPCyl., Sph."; +#define FC .92131773192356127802 +#define RP .31830988618379067154 +FORWARD(s_forward); /* spheroid */ + xy.x = FC * lp.lam * (1. - RP * fabs(lp.phi)); + xy.y = FC * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / FC; + lp.lam = xy.x / (FC * (1. - RP * fabs(lp.phi))); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(eck1) + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_eck2.c b/src/PJ_eck2.c new file mode 100644 index 00000000..ebfdbda3 --- /dev/null +++ b/src/PJ_eck2.c @@ -0,0 +1,31 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eck2.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(eck2, "Eckert II") "\n\tPCyl. Sph."; +#define FXC 0.46065886596178063902 +#define FYC 1.44720250911653531871 +#define C13 0.33333333333333333333 +#define ONEEPS 1.0000001 +FORWARD(s_forward); /* spheroid */ + xy.x = FXC * lp.lam * (xy.y = sqrt(4. - 3. * sin(fabs(lp.phi)))); + xy.y = FYC * (2. - xy.y); + if ( lp.phi < 0.) xy.y = -xy.y; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.lam = xy.x / (FXC * ( lp.phi = 2. - fabs(xy.y) / FYC) ); + lp.phi = (4. - lp.phi * lp.phi) * C13; + if (fabs(lp.phi) >= 1.) { + if (fabs(lp.phi) > ONEEPS) I_ERROR + else + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + } else + lp.phi = asin(lp.phi); + if (xy.y < 0) + lp.phi = -lp.phi; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(eck2); P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_eck3.c b/src/PJ_eck3.c new file mode 100644 index 00000000..37a56695 --- /dev/null +++ b/src/PJ_eck3.c @@ -0,0 +1,53 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eck3.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x, C_y, A, B; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(eck3, "Eckert III") "\n\tPCyl, Sph."; +PROJ_HEAD(putp1, "Putnins P1") "\n\tPCyl, Sph."; +PROJ_HEAD(wag6, "Wagner VI") "\n\tPCyl, Sph."; +PROJ_HEAD(kav7, "Kavraisky VII") "\n\tPCyl, Sph."; +FORWARD(s_forward); /* spheroid */ + xy.y = P->C_y * lp.phi; + xy.x = P->C_x * lp.lam * (P->A + asqrt(1. - P->B * lp.phi * lp.phi)); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / P->C_y; + lp.lam = xy.x / (P->C_x * (P->A + asqrt(1. - P->B * lp.phi * lp.phi))); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->es = 0.; + P->inv = s_inverse; + P->fwd = s_forward; + return P; +} +ENTRY0(eck3) + P->C_x = .42223820031577120149; + P->C_y = .84447640063154240298; + P->A = 1.; + P->B = 0.4052847345693510857755; +ENDENTRY(setup(P)) +ENTRY0(kav7) + P->C_x = 0.2632401569273184856851; + P->C_x = 0.8660254037844; + P->C_y = 1.; + P->A = 0.; + P->B = 0.30396355092701331433; +ENDENTRY(setup(P)) +ENTRY0(wag6); + P->C_x = P->C_y = 0.94745; + P->A = 0.; + P->B = 0.30396355092701331433; +ENDENTRY(setup(P)) +ENTRY0(putp1); + P->C_x = 1.89490; + P->C_y = 0.94745; + P->A = -0.5; + P->B = 0.30396355092701331433; +ENDENTRY(setup(P)) diff --git a/src/PJ_eck4.c b/src/PJ_eck4.c new file mode 100644 index 00000000..9784a1c4 --- /dev/null +++ b/src/PJ_eck4.c @@ -0,0 +1,47 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eck4.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(eck4, "Eckert IV") "\n\tPCyl, Sph."; +#define C_x .42223820031577120149 +#define C_y 1.32650042817700232218 +#define RC_y .75386330736002178205 +#define C_p 3.57079632679489661922 +#define RC_p .28004957675577868795 +#define EPS 1e-7 +#define NITER 6 +FORWARD(s_forward); /* spheroid */ + double p, V, s, c; + int i; + + p = C_p * sin(lp.phi); + V = lp.phi * lp.phi; + lp.phi *= 0.895168 + V * ( 0.0218849 + V * 0.00826809 ); + for (i = NITER; i ; --i) { + c = cos(lp.phi); + s = sin(lp.phi); + lp.phi -= V = (lp.phi + s * (c + 2.) - p) / + (1. + c * (c + 2.) - s * s); + if (fabs(V) < EPS) + break; + } + if (!i) { + xy.x = C_x * lp.lam; + xy.y = lp.phi < 0. ? -C_y : C_y; + } else { + xy.x = C_x * lp.lam * (1. + cos(lp.phi)); + xy.y = C_y * sin(lp.phi); + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double c; + + lp.phi = aasin(xy.y / C_y); + lp.lam = xy.x / (C_x * (1. + (c = cos(lp.phi)))); + lp.phi = aasin((lp.phi + sin(lp.phi) * (c + 2.)) / C_p); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(eck4); P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_eck5.c b/src/PJ_eck5.c new file mode 100644 index 00000000..00b2cae6 --- /dev/null +++ b/src/PJ_eck5.c @@ -0,0 +1,21 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eck5.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(eck5, "Eckert V") "\n\tPCyl, Sph."; +#define XF 0.44101277172455148219 +#define RXF 2.26750802723822639137 +#define YF 0.88202554344910296438 +#define RYF 1.13375401361911319568 +FORWARD(s_forward); /* spheroid */ + xy.x = XF * (1. + cos(lp.phi)) * lp.lam; + xy.y = YF * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.lam = RXF * xy.x / (1. + cos( lp.phi = RYF * xy.y)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(eck5); P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_eqc.c b/src/PJ_eqc.c new file mode 100644 index 00000000..d956a47b --- /dev/null +++ b/src/PJ_eqc.c @@ -0,0 +1,26 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eqc.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double rc; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(eqc, "Equidistant Cylindrical (Plate Caree)") + "\n\tCyl, Sph\n\tlat_ts="; +FORWARD(s_forward); /* spheroid */ + xy.x = P->rc * lp.lam; + xy.y = lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y; + lp.lam = xy.x / P->rc; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(eqc) + if ((P->rc = cos(pj_param(P->params, "rlat_ts").f)) <= 0.) E_ERROR(-24); + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_eqdc.c b/src/PJ_eqdc.c new file mode 100644 index 00000000..349266ff --- /dev/null +++ b/src/PJ_eqdc.c @@ -0,0 +1,89 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_eqdc.c 4.2 94/03/16 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phi1; \ + double phi2; \ + double n; \ + double rho; \ + double rho0; \ + double c; \ + double *en; \ + int ellips; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(eqdc, "Equidistant Conic") + "\n\tConic, Sph&Ell\n\tlat_1= lat_2="; +# define EPS10 1.e-10 +FORWARD(e_forward); /* sphere & ellipsoid */ + P->rho = P->c - (P->ellips ? pj_mlfn(lp.phi, sin(lp.phi), + cos(lp.phi), P->en) : lp.phi); + xy.x = P->rho * sin( lp.lam *= P->n ); + xy.y = P->rho0 - P->rho * cos(lp.lam); + return (xy); +} +INVERSE(e_inverse); /* sphere & ellipsoid */ + if (P->rho = hypot(xy.x, xy.y = P->rho0 - xy.y)) { + if (P->n < 0.) { + P->rho = -P->rho; + xy.x = -xy.x; + xy.y = -xy.y; + } + lp.phi = P->c - P->rho; + if (P->ellips) + lp.phi = pj_inv_mlfn(lp.phi, P->es, P->en); + lp.lam = atan2(xy.x, xy.y) / P->n; + } else { + lp.lam = 0.; + lp.phi = P->n > 0. ? HALFPI : - HALFPI; + } + return (lp); +} +SPECIAL(fac) { + double sinphi, cosphi; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + fac->code |= IS_ANAL_HK; + fac->h = 1.; + fac->k = P->n * (P->c - (P->ellips ? pj_mlfn(lp.phi, sinphi, + cosphi, P->en) : lp.phi)) / pj_msfn(sinphi, cosphi, P->es); +} +FREEUP; if (P) { if (P->en) pj_dalloc(P->en); pj_dalloc(P); } } +ENTRY1(eqdc, en) + double cosphi, sinphi; + int secant; + + P->phi1 = pj_param(P->params, "rlat_1").f; + P->phi2 = pj_param(P->params, "rlat_2").f; + if (fabs(P->phi1 + P->phi2) < EPS10) E_ERROR(-21); + if (!(P->en = pj_enfn(P->es))) + E_ERROR_0; + P->n = sinphi = sin(P->phi1); + cosphi = cos(P->phi1); + secant = fabs(P->phi1 - P->phi2) >= EPS10; + if (P->ellips = P->es > 0.) { + double ml1, m1; + + m1 = pj_msfn(sinphi, cosphi, P->es); + P->en = pj_enfn(P->es); + ml1 = pj_mlfn(P->phi1, sinphi, cosphi, P->en); + if (secant) { /* secant cone */ + sinphi = sin(P->phi2); + cosphi = cos(P->phi2); + P->n = (m1 - pj_msfn(sinphi, cosphi, P->es)) / + (pj_mlfn(P->phi2, sinphi, cosphi, P->en) - ml1); + } + P->c = ml1 + m1 / P->n; + P->rho0 = P->c - pj_mlfn(P->phi0, sin(P->phi0), + cos(P->phi0), P->en); + } else { + if (secant) + P->n = (cosphi - cos(P->phi2)) / (P->phi2 - P->phi1); + P->c = P->phi1 + cos(P->phi1) / P->n; + P->rho0 = P->c - P->phi0; + } + P->inv = e_inverse; + P->fwd = e_forward; + P->spc = fac; +ENDENTRY(P) diff --git a/src/PJ_fahey.c b/src/PJ_fahey.c new file mode 100644 index 00000000..f49f7401 --- /dev/null +++ b/src/PJ_fahey.c @@ -0,0 +1,20 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_fahey.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(fahey, "Fahey") "\n\tPcyl, Sph."; +#define TOL 1e-6 +FORWARD(s_forward); /* spheroid */ + xy.y = 1.819152 * ( xy.x = tan(0.5 * lp.phi) ); + xy.x = 0.819152 * lp.lam * asqrt(1 - xy.x * xy.x); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = 2. * atan(xy.y /= 1.819152); + lp.lam = fabs(xy.y = 1. - xy.y * xy.y) < TOL ? 0. : + xy.x / (0.819152 * sqrt(xy.y)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(fahey) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_fouc_s.c b/src/PJ_fouc_s.c new file mode 100644 index 00000000..ab6225c6 --- /dev/null +++ b/src/PJ_fouc_s.c @@ -0,0 +1,48 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_fouc_s.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double n, n1; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(fouc_s, "Foucaut Sinusoidal") "\n\tPCyl., Sph."; +#define MAX_ITER 10 +#define LOOP_TOL 1e-7 +FORWARD(s_forward); /* spheroid */ + double t; + + t = cos(lp.phi); + xy.x = lp.lam * t / (P->n + P->n1 * t); + xy.y = P->n * lp.phi + P->n1 * sin(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double V; + int i; + + if (P->n) { + lp.phi = xy.y; + for (i = MAX_ITER; i ; --i) { + lp.phi -= V = (P->n * lp.phi + P->n1 * sin(lp.phi) - xy.y ) / + (P->n + P->n1 * cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + if (!i) + lp.phi = xy.y < 0. ? -HALFPI : HALFPI; + } else + lp.phi = aasin(xy.y); + V = cos(lp.phi); + lp.lam = xy.x * (P->n + P->n1 * V) / V; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(fouc_s) + P->n = pj_param(P->params, "dn").f; + if (P->n < 0. || P->n > 1.) + E_ERROR(-99) + P->n1 = 1. - P->n; + P->es = 0; + P->inv = s_inverse; + P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_gall.c b/src/PJ_gall.c new file mode 100644 index 00000000..537c91af --- /dev/null +++ b/src/PJ_gall.c @@ -0,0 +1,22 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_gall.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(gall, "Gall (Gall Stereographic)") "\n\tCyl, Sph"; +#define YF 1.70710678118654752440 +#define XF 0.70710678118654752440 +#define RYF 0.58578643762690495119 +#define RXF 1.41421356237309504880 +FORWARD(s_forward); /* spheroid */ + xy.x = XF * lp.lam; + xy.y = YF * tan(.5 * lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.lam = RXF * xy.x; + lp.phi = 2. * atan(xy.y * RYF); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(gall) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_gins8.c b/src/PJ_gins8.c new file mode 100644 index 00000000..c288a61d --- /dev/null +++ b/src/PJ_gins8.c @@ -0,0 +1,20 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_gins8.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(gins8, "Ginsburg VIII (TsNIIGAiK)") "\n\tPCyl, Sph., no inv."; +#define Cl 0.000952426 +#define Cp 0.162388 +#define C12 0.08333333333333333 +FORWARD(s_forward); /* spheroid */ + double t = lp.phi * lp.phi; + + xy.y = lp.phi * (1. + t * C12); + xy.x = lp.lam * (1. - Cp * t); + t = lp.lam * lp.lam; + xy.x *= (0.87 - Cl * t * t); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(gins8) P->es = 0.; P->inv = 0; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_gn_sinu.c b/src/PJ_gn_sinu.c new file mode 100644 index 00000000..62cdc872 --- /dev/null +++ b/src/PJ_gn_sinu.c @@ -0,0 +1,104 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_gn_sinu.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double *en; \ + double m, n, C_x, C_y; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(gn_sinu, "General Sinusoidal Series") "\n\tPCyl, Sph.\n\tm= n="; +PROJ_HEAD(sinu, "Sinusoidal (Sanson-Flamsteed)") "\n\tPCyl, Sph&Ell"; +PROJ_HEAD(eck6, "Eckert VI") "\n\tPCyl, Sph."; +PROJ_HEAD(mbtfps, "McBryde-Thomas Flat-Polar Sinusoidal") "\n\tPCyl, Sph."; +#define EPS10 1e-10 +#define MAX_ITER 8 +#define LOOP_TOL 1e-7 +/* Ellipsoidal Sinusoidal only */ +FORWARD(e_forward); /* ellipsoid */ + double s, c; + + xy.y = pj_mlfn(lp.phi, s = sin(lp.phi), c = cos(lp.phi), P->en); + xy.x = lp.lam * c / sqrt(1. - P->es * s * s); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + double s; + + if ((s = fabs(lp.phi = pj_inv_mlfn(xy.y, P->es, P->en))) < HALFPI) { + s = sin(lp.phi); + lp.lam = xy.x * sqrt(1. - P->es * s * s) / cos(lp.phi); + } else if ((s - EPS10) < HALFPI) + lp.lam = 0.; + else I_ERROR; + return (lp); +} +/* General spherical sinusoidals */ +FORWARD(s_forward); /* sphere */ + if (!P->m) + lp.phi = P->n != 1. ? aasin(P->n * sin(lp.phi)): lp.phi; + else { + double k, V; + int i; + + k = P->n * sin(lp.phi); + for (i = MAX_ITER; i ; --i) { + lp.phi -= V = (P->m * lp.phi + sin(lp.phi) - k) / + (P->m + cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + if (!i) + F_ERROR + } + xy.x = P->C_x * lp.lam * (P->m + cos(lp.phi)); + xy.y = P->C_y * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* sphere */ + double s; + + xy.y /= P->C_y; + lp.phi = P->m ? aasin((P->m * xy.y + sin(xy.y)) / P->n) : + ( P->n != 1. ? aasin(sin(xy.y) / P->n) : xy.y ); + lp.lam = xy.x / (P->C_x * (P->m + cos(xy.y))); + return (lp); +} +FREEUP; if (P) { if (P->en) pj_dalloc(P->en); pj_dalloc(P); } } + static void /* for spheres, only */ +setup(PJ *P) { + P->es = 0; + P->C_x = (P->C_y = sqrt((P->m + 1.) / P->n))/(P->m + 1.); + P->inv = s_inverse; + P->fwd = s_forward; +} +ENTRY1(sinu, en) + if (!(P->en = pj_enfn(P->es))) + E_ERROR_0; + if (P->es) { + P->en = pj_enfn(P->es); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + P->n = 1.; + P->m = 0.; + setup(P); + } +ENDENTRY(P) +ENTRY1(eck6, en) + P->m = 1.; + P->n = 2.570796326794896619231321691; + setup(P); +ENDENTRY(P) +ENTRY1(mbtfps, en) + P->m = 0.5; + P->n = 1.785398163397448309615660845; + setup(P); +ENDENTRY(P) +ENTRY1(gn_sinu, en) + if (pj_param(P->params, "tn").i && pj_param(P->params, "tm").i) { + P->n = pj_param(P->params, "dn").f; + P->m = pj_param(P->params, "dm").f; + } else + E_ERROR(-99) + setup(P); +ENDENTRY(P) diff --git a/src/PJ_gnom.c b/src/PJ_gnom.c new file mode 100644 index 00000000..ecf57739 --- /dev/null +++ b/src/PJ_gnom.c @@ -0,0 +1,108 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_gnom.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double sinph0; \ + double cosph0; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(gnom, "Gnomonic") "\n\tAzi, Sph."; +#define EPS10 1.e-10 +#define N_POLE 0 +#define S_POLE 1 +#define EQUIT 2 +#define OBLIQ 3 +FORWARD(s_forward); /* spheroid */ + double coslam, cosphi, sinphi; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + switch (P->mode) { + case EQUIT: + xy.y = cosphi * coslam; + break; + case OBLIQ: + xy.y = P->sinph0 * sinphi + P->cosph0 * cosphi * coslam; + break; + case S_POLE: + xy.y = - sinphi; + break; + case N_POLE: + xy.y = sinphi; + break; + } + if (xy.y <= EPS10) F_ERROR; + xy.x = (xy.y = 1. / xy.y) * cosphi * sin(lp.lam); + switch (P->mode) { + case EQUIT: + xy.y *= sinphi; + break; + case OBLIQ: + xy.y *= P->cosph0 * sinphi - P->sinph0 * cosphi * coslam; + break; + case N_POLE: + coslam = - coslam; + case S_POLE: + xy.y *= cosphi * coslam; + break; + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double rh, cosz, sinz; + + rh = hypot(xy.x, xy.y); + sinz = sin(lp.phi = atan(rh)); + cosz = sqrt(1. - sinz * sinz); + if (fabs(rh) <= EPS10) { + lp.phi = P->phi0; + lp.lam = 0.; + } else { + switch (P->mode) { + case OBLIQ: + lp.phi = cosz * P->sinph0 + xy.y * sinz * P->cosph0 / rh; + if (fabs(lp.phi) >= 1.) + lp.phi = lp.phi > 0. ? HALFPI : - HALFPI; + else + lp.phi = asin(lp.phi); + xy.y = (cosz - P->sinph0 * sin(lp.phi)) * rh; + xy.x *= sinz * P->cosph0; + break; + case EQUIT: + lp.phi = xy.y * sinz / rh; + if (fabs(lp.phi) >= 1.) + lp.phi = lp.phi > 0. ? HALFPI : - HALFPI; + else + lp.phi = asin(lp.phi); + xy.y = cosz * rh; + xy.x *= sinz; + break; + case S_POLE: + lp.phi -= HALFPI; + break; + case N_POLE: + lp.phi = HALFPI - lp.phi; + xy.y = -xy.y; + break; + } + lp.lam = atan2(xy.x, xy.y); + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(gnom) + if (fabs(fabs(P->phi0) - HALFPI) < EPS10) + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + else if (fabs(P->phi0) < EPS10) + P->mode = EQUIT; + else { + P->mode = OBLIQ; + P->sinph0 = sin(P->phi0); + P->cosph0 = cos(P->phi0); + } + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_goode.c b/src/PJ_goode.c new file mode 100644 index 00000000..d1e6c447 --- /dev/null +++ b/src/PJ_goode.c @@ -0,0 +1,49 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_goode.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + struct PJconsts *sinu; \ + struct PJconsts *moll; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(goode, "Goode Homolosine") "\n\tPCyl, Sph."; + extern PJ +*pj_sinu(PJ *), *pj_moll(PJ *); +#define Y_COR 0.05280 +#define PHI_LIM .71093078197902358062 +FORWARD(s_forward); /* spheroid */ + if (fabs(lp.phi) <= PHI_LIM) + xy = P->sinu->fwd(lp, P->sinu); + else { + xy = P->moll->fwd(lp, P->moll); + xy.y -= lp.phi >= 0.0 ? Y_COR : -Y_COR; + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + if (fabs(xy.y) <= PHI_LIM) + lp = P->sinu->inv(xy, P->sinu); + else { + xy.y += xy.y >= 0.0 ? Y_COR : -Y_COR; + lp = P->moll->inv(xy, P->moll); + } + return (lp); +} +FREEUP; + if (P) { + if (P->sinu) + (*(P->sinu->pfree))(P->sinu); + if (P->moll) + (*(P->moll->pfree))(P->moll); + pj_dalloc(P); + } +} +ENTRY2(goode, sinu, moll) + P->es = 0.; + if (!(P->sinu = pj_sinu(0)) || !(P->moll = pj_moll(0))) + E_ERROR_0; + if (!(P->sinu = pj_sinu(P->sinu)) || !(P->moll = pj_moll(P->moll))) + E_ERROR_0; + P->fwd = s_forward; + P->inv = s_inverse; +ENDENTRY(P) diff --git a/src/PJ_hammer.c b/src/PJ_hammer.c new file mode 100644 index 00000000..813d6e5f --- /dev/null +++ b/src/PJ_hammer.c @@ -0,0 +1,32 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_hammer.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double w; \ + double m, rm; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(hammer, "Hammer & Eckert-Greifendorff") + "\n\tMisc Sph, no inv.\n\tW= M="; +FORWARD(s_forward); /* spheroid */ + double cosphi, d; + + d = sqrt(2./(1. + (cosphi = cos(lp.phi)) * cos(lp.lam *= P->w))); + xy.x = P->m * d * cosphi * sin(lp.lam); + xy.y = P->rm * d * sin(lp.phi); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(hammer) + if (pj_param(P->params, "tW").i) { + if ((P->w = fabs(pj_param(P->params, "dW").f)) <= 0.) E_ERROR(-27); + } else + P->w = .5; + if (pj_param(P->params, "tM").i) { + if ((P->m = fabs(pj_param(P->params, "dM").f)) <= 0.) E_ERROR(-27); + } else + P->m = 1.; + P->rm = 1. / P->m; + P->m /= P->w; + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_hatano.c b/src/PJ_hatano.c new file mode 100644 index 00000000..8b661b3c --- /dev/null +++ b/src/PJ_hatano.c @@ -0,0 +1,53 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_hatano.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(hatano, "Hatano Asymmetrical Equal Area") "\n\tPCyl, Sph."; +#define NITER 20 +#define EPS 1e-7 +#define ONETOL 1.000001 +#define CN 2.67595 +#define CS 2.43763 +#define RCN 0.37369906014686373063 +#define RCS 0.41023453108141924738 +#define FYCN 1.75859 +#define FYCS 1.93052 +#define RYCN 0.56863737426006061674 +#define RYCS 0.51799515156538134803 +#define FXC 0.85 +#define RXC 1.17647058823529411764 +FORWARD(s_forward); /* spheroid */ + double th1, c; + int i; + + c = sin(lp.phi) * (lp.phi < 0. ? CS : CN); + for (i = NITER; i; --i) { + lp.phi -= th1 = (lp.phi + sin(lp.phi) - c) / (1. + cos(lp.phi)); + if (fabs(th1) < EPS) break; + } + xy.x = FXC * lp.lam * cos(lp.phi *= .5); + xy.y = sin(lp.phi) * (lp.phi < 0. ? FYCS : FYCN); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double th; + + th = xy.y * ( xy.y < 0. ? RYCS : RYCN); + if (fabs(th) > 1.) + if (fabs(th) > ONETOL) I_ERROR + else th = th > 0. ? HALFPI : - HALFPI; + else + th = asin(th); + lp.lam = RXC * xy.x / cos(th); + th += th; + lp.phi = (th + sin(th)) * (xy.y < 0. ? RCS : RCN); + if (fabs(lp.phi) > 1.) + if (fabs(lp.phi) > ONETOL) I_ERROR + else lp.phi = lp.phi > 0. ? HALFPI : - HALFPI; + else + lp.phi = asin(lp.phi); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(hatano) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_imw_p.c b/src/PJ_imw_p.c new file mode 100644 index 00000000..58d04f8c --- /dev/null +++ b/src/PJ_imw_p.c @@ -0,0 +1,154 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_imw_p.c 4.1 94/05/22 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double P, Pp, Q, Qp, R_1, R_2, sphi_1, sphi_2, C2; \ + double phi_1, phi_2, lam_1; \ + double *en; \ + int mode; /* = 0, phi_1 and phi_2 != 0, = 1, phi_1 = 0, = -1 phi_2 = 0 */ +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(imw_p, "International Map of the World Polyconic") + "\n\tMod. Polyconic, Ell\n\tlat_1= and lat_2= [lon_1=]"; +#define TOL 1e-10 +#define EPS 1e-10 + static int +phi12(PJ *P, double *del, double *sig) { + int err = 0; + + if (!pj_param(P->params, "tlat_1").i || + !pj_param(P->params, "tlat_2").i) { + err = -41; + } else { + P->phi_1 = pj_param(P->params, "rlat_1").f; + P->phi_2 = pj_param(P->params, "rlat_2").f; + *del = 0.5 * (P->phi_2 - P->phi_1); + *sig = 0.5 * (P->phi_2 + P->phi_1); + err = (fabs(*del) < EPS || fabs(*sig) < EPS) ? -42 : 0; + } + return err; +} + static XY +loc_for(LP lp, PJ *P, double *yc) { + XY xy; + + if (! lp.phi) { + xy.x = lp.lam; + xy.y = 0.; + } else { + double xa, ya, xb, yb, xc, yc, D, B, m, sp, t, R, C; + + sp = sin(lp.phi); + m = pj_mlfn(lp.phi, sp, cos(lp.phi), P->en); + xa = P->Pp + P->Qp * m; + ya = P->P + P->Q * m; + R = 1. / (tan(lp.phi) * sqrt(1. - P->es * sp * sp)); + C = sqrt(R * R - xa * xa); + if (lp.phi < 0.) C = - C; + C += ya - R; + if (P->mode < 0) { + xb = lp.lam; + yb = P->C2; + } else { + t = lp.lam * P->sphi_2; + xb = P->R_2 * sin(t); + yb = P->C2 + P->R_2 * (1. - cos(t)); + } + if (P->mode > 0) { + xc = lp.lam; + yc = 0.; + } else { + t = lp.lam * P->sphi_1; + xc = P->R_1 * sin(t); + yc = P->R_1 * (1. - cos(t)); + } + D = (xb - xc)/(yb - yc); + B = xc + D * (C + R - yc); + xy.x = D * sqrt(R * R * (1 + D * D) - B * B); + if (lp.phi > 0) + xy.x = - xy.x; + xy.x = (B + xy.x) / (1. + D * D); + xy.y = sqrt(R * R - xy.x * xy.x); + if (lp.phi > 0) + xy.y = - xy.y; + xy.y += C + R; + } + return (xy); +} +FORWARD(e_forward); /* ellipsoid */ + double yc; + xy = loc_for(lp, P, &yc); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + XY t; + double yc; + + lp.phi = P->phi_2; + lp.lam = xy.x / cos(lp.phi); + do { + t = loc_for(lp, P, &yc); + lp.phi = ((lp.phi - P->phi_1) * (xy.y - yc) / (t.y - yc)) + P->phi_1; + lp.lam = lp.lam * xy.x / t.x; + } while (fabs(t.x - xy.x) > TOL || fabs(t.y - xy.y) > TOL); + return (lp); +} + static void +xy(PJ *P, double phi, double *x, double *y, double *sp, double *R) { + double t, F; + + *sp = sin(phi); + *R = 1./(tan(phi) * sqrt(1. - P->es * *sp * *sp )); + F = P->lam_1 * *sp; + *y = *R * (1 - cos(F)); + *x = *R * sin(F); +} +FREEUP; if (P) { if (P->en) pj_dalloc(P->en); pj_dalloc(P); } } +ENTRY1(imw_p, en) + double del, sig, s, t, x1, x2, T2, y1, m1, m2, y2; + int i; + + if (!(P->en = pj_enfn(P->es))) E_ERROR_0; + if (i = phi12(P, &del, &sig)) + E_ERROR(i); + if (P->phi_2 < P->phi_1) { /* make sure P->phi_1 most southerly */ + del = P->phi_1; + P->phi_1 = P->phi_2; + P->phi_2 = del; + } + if (pj_param(P->params, "tlon_1").i) + P->lam_1 = pj_param(P->params, "rlon_1").f; + else { /* use predefined based upon latitude */ + sig = fabs(sig * RAD_TO_DEG); + if (sig <= 60) sig = 2.; + else if (sig <= 76) sig = 4.; + else sig = 8.; + P->lam_1 = sig * DEG_TO_RAD; + } + P->mode = 0; + if (P->phi_1) xy(P, P->phi_1, &x1, &y1, &P->sphi_1, &P->R_1); + else { + P->mode = 1; + y1 = 0.; + x1 = P->lam_1; + } + if (P->phi_2) xy(P, P->phi_2, &x2, &T2, &P->sphi_2, &P->R_2); + else { + P->mode = -1; + T2 = 0.; + x2 = P->lam_1; + } + m1 = pj_mlfn(P->phi_1, P->sphi_1, cos(P->phi_1), P->en); + m2 = pj_mlfn(P->phi_2, P->sphi_2, cos(P->phi_2), P->en); + t = m2 - m1; + s = x2 - x1; + y2 = sqrt(t * t - s * s) + y1; + P->C2 = y2 - T2; + t = 1. / t; + P->P = (m2 * y1 - m1 * y2) * t; + P->Q = (y2 - y1) * t; + P->Pp = (m2 * x1 - m1 * x2) * t; + P->Qp = (x2 - x1) * t; + P->fwd = e_forward; + P->inv = e_inverse; +ENDENTRY(P) diff --git a/src/PJ_labrd.c b/src/PJ_labrd.c new file mode 100644 index 00000000..01b0406f --- /dev/null +++ b/src/PJ_labrd.c @@ -0,0 +1,112 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_labrd.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double Az, kRg, p0s, A, C, Ca, Cb, Cc, Cd; \ + int rot; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(labrd, "Laborde") "\n\tCyl, Sph\n\tSpecial for Madagascar"; +#define EPS 1.e-10 +FORWARD(e_forward); + double V1, V2, ps, sinps, cosps, sinps2, cosps2, I1, I2, I3, I4, I5, I6, + x2, y2, t; + + V1 = P->A * log( tan(FORTPI + .5 * lp.phi) ); + t = P->e * sin(lp.phi); + V2 = .5 * P->e * P->A * log ((1. + t)/(1. - t)); + ps = 2. * (atan(exp(V1 - V2 + P->C)) - FORTPI); + I1 = ps - P->p0s; + cosps = cos(ps); cosps2 = cosps * cosps; + sinps = sin(ps); sinps2 = sinps * sinps; + I4 = P->A * cosps; + I2 = .5 * P->A * I4 * sinps; + I3 = I2 * P->A * P->A * (5. * cosps2 - sinps2) / 12.; + I6 = I4 * P->A * P->A; + I5 = I6 * (cosps2 - sinps2) / 6.; + I6 *= P->A * P->A * + (5. * cosps2 * cosps2 + sinps2 * (sinps2 - 18. * cosps2)) / 120.; + t = lp.lam * lp.lam; + xy.x = P->kRg * lp.lam * (I4 + t * (I5 + t * I6)); + xy.y = P->kRg * (I1 + t * (I2 + t * I3)); + x2 = xy.x * xy.x; + y2 = xy.y * xy.y; + V1 = 3. * xy.x * y2 - xy.x * x2; + V2 = xy.y * y2 - 3. * x2 * xy.y; + xy.x += P->Ca * V1 + P->Cb * V2; + xy.y += P->Ca * V2 - P->Cb * V1; + return (xy); +} +INVERSE(e_inverse); /* ellipsoid & spheroid */ + double x2, y2, V1, V2, V3, V4, t, t2, ps, pe, tpe, s, + I7, I8, I9, I10, I11, d, Re; + int i; + + x2 = xy.x * xy.x; + y2 = xy.y * xy.y; + V1 = 3. * xy.x * y2 - xy.x * x2; + V2 = xy.y * y2 - 3. * x2 * xy.y; + V3 = xy.x * (5. * y2 * y2 + x2 * (-10. * y2 + x2 )); + V4 = xy.y * (5. * x2 * x2 + y2 * (-10. * x2 + y2 )); + xy.x += - P->Ca * V1 - P->Cb * V2 + P->Cc * V3 + P->Cd * V4; + xy.y += P->Cb * V1 - P->Ca * V2 - P->Cd * V3 + P->Cc * V4; + ps = P->p0s + xy.y / P->kRg; + pe = ps + P->phi0 - P->p0s; + for ( i = 20; i; --i) { + V1 = P->A * log(tan(FORTPI + .5 * pe)); + tpe = P->e * sin(pe); + V2 = .5 * P->e * P->A * log((1. + tpe)/(1. - tpe)); + t = ps - 2. * (atan(exp(V1 - V2 + P->C)) - FORTPI); + pe += t; + if (fabs(t) < EPS) + break; + } +/* + if (!i) { + } else { + } +*/ + t = P->e * sin(pe); + t = 1. - t * t; + Re = P->one_es / ( t * sqrt(t) ); + t = tan(ps); + t2 = t * t; + s = P->kRg * P->kRg; + d = Re * P->k0 * P->kRg; + I7 = t / (2. * d); + I8 = t * (5. + 3. * t2) / (24. * d * s); + d = cos(ps) * P->kRg * P->A; + I9 = 1. / d; + d *= s; + I10 = (1. + 2. * t2) / (6. * d); + I11 = (5. + t2 * (28. + 24. * t2)) / (120. * d * s); + x2 = xy.x * xy.x; + lp.phi = pe + x2 * (-I7 + I8 * x2); + lp.lam = xy.x * (I9 + x2 * (-I10 + x2 * I11)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(labrd) + double Az, sinp, R, N, t; + + P->rot = pj_param(P->params, "bno_rot").i == 0; + Az = pj_param(P->params, "razi").f; + sinp = sin(P->phi0); + t = 1. - P->es * sinp * sinp; + N = 1. / sqrt(t); + R = P->one_es * N / t; + P->kRg = P->k0 * sqrt( N * R ); + P->p0s = atan( sqrt(R / N) * tan(P->phi0) ); + P->A = sinp / sin(P->p0s); + t = P->e * sinp; + P->C = .5 * P->e * P->A * log((1. + t)/(1. - t)) + + - P->A * log( tan(FORTPI + .5 * P->phi0)) + + log( tan(FORTPI + .5 * P->p0s)); + t = Az + Az; + P->Ca = (1. - cos(t)) * ( P->Cb = 1. / (12. * P->kRg * P->kRg) ); + P->Cb *= sin(t); + P->Cc = 3. * (P->Ca * P->Ca - P->Cb * P->Cb); + P->Cd = 6. * P->Ca * P->Cb; + P->inv = e_inverse; + P->fwd = e_forward; +ENDENTRY(P) diff --git a/src/PJ_laea.c b/src/PJ_laea.c new file mode 100644 index 00000000..dab96700 --- /dev/null +++ b/src/PJ_laea.c @@ -0,0 +1,230 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_laea.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double sinb1; \ + double cosb1; \ + double xmf; \ + double ymf; \ + double mmf; \ + double qp; \ + double dd; \ + double rq; \ + double *apa; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(laea, "Lambert Azimuthal Equal Area") "\n\tAzi, Sph&Ell"; +#define sinph0 P->sinb1 +#define cosph0 P->cosb1 +#define EPS10 1.e-10 +#define NITER 20 +#define CONV 1.e-10 +#define N_POLE 0 +#define S_POLE 1 +#define EQUIT 2 +#define OBLIQ 3 +FORWARD(e_forward); /* ellipsoid */ + double coslam, sinlam, sinphi, q, sinb, cosb, b; + + coslam = cos(lp.lam); + sinlam = sin(lp.lam); + sinphi = sin(lp.phi); + q = pj_qsfn(sinphi, P->e, P->one_es); + if (P->mode == OBLIQ || P->mode == EQUIT) { + sinb = q / P->qp; + cosb = sqrt(1. - sinb * sinb); + } + switch (P->mode) { + case OBLIQ: + b = 1. + P->sinb1 * sinb + P->cosb1 * cosb * coslam; + break; + case EQUIT: + b = 1. + cosb * coslam; + break; + case N_POLE: + b = HALFPI + lp.phi; + q = P->qp - q; + break; + case S_POLE: + b = lp.phi - HALFPI; + q = P->qp + q; + break; + } + if (fabs(b) < EPS10) F_ERROR; + switch (P->mode) { + case OBLIQ: + xy.y = P->ymf * ( b = sqrt(2. / b) ) + * (P->cosb1 * sinb - P->sinb1 * cosb * coslam); + goto eqcon; + break; + case EQUIT: + xy.y = (b = sqrt(2. / (1. + cosb * coslam))) * sinb * P->ymf; +eqcon: + xy.x = P->xmf * b * cosb * sinlam; + break; + case N_POLE: + case S_POLE: + if (q >= 0.) { + xy.x = (b = sqrt(q)) * sinlam; + xy.y = coslam * (P->mode == S_POLE ? b : -b); + } else + xy.x = xy.y = 0.; + break; + } + return (xy); +} +FORWARD(s_forward); /* spheroid */ + double coslam, cosphi, sinphi; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + switch (P->mode) { + case EQUIT: + xy.y = 1. + cosphi * coslam; + goto oblcon; + case OBLIQ: + xy.y = 1. + sinph0 * sinphi + cosph0 * cosphi * coslam; +oblcon: + if (xy.y <= EPS10) F_ERROR; + xy.x = (xy.y = sqrt(2. / xy.y)) * cosphi * sin(lp.lam); + xy.y *= P->mode == EQUIT ? sinphi : + cosph0 * sinphi - sinph0 * cosphi * coslam; + break; + case N_POLE: + coslam = -coslam; + case S_POLE: + if (fabs(lp.phi + P->phi0) < EPS10) F_ERROR; + xy.y = FORTPI - lp.phi * .5; + xy.y = 2. * (P->mode == S_POLE ? cos(xy.y) : sin(xy.y)); + xy.x = xy.y * sin(lp.lam); + xy.y *= coslam; + break; + } + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + double cCe, sCe, q, rho, ab; + + switch (P->mode) { + case EQUIT: + case OBLIQ: + if ((rho = hypot(xy.x /= P->dd, xy.y *= P->dd)) < EPS10) { + lp.lam = 0.; + lp.phi = P->phi0; + return (lp); + } + cCe = cos(sCe = 2. * asin(.5 * rho / P->rq)); + xy.x *= (sCe = sin(sCe)); + if (P->mode == OBLIQ) { + q = P->qp * (ab = cCe * P->sinb1 + xy.y * sCe * P->cosb1 / rho); + xy.y = rho * P->cosb1 * cCe - xy.y * P->sinb1 * sCe; + } else { + q = P->qp * (ab = xy.y * sCe / rho); + xy.y = rho * cCe; + } + break; + case N_POLE: + xy.y = -xy.y; + case S_POLE: + if (!(q = (xy.x * xy.x + xy.y * xy.y)) ) { + lp.lam = 0.; + lp.phi = P->phi0; + return (lp); + } + /* + q = P->qp - q; + */ + ab = 1. - q / P->qp; + if (P->mode == S_POLE) + ab = - ab; + break; + } + lp.lam = atan2(xy.x, xy.y); + lp.phi = pj_authlat(asin(ab), P->apa); + return (lp); +} +INVERSE(s_inverse); /* spheroid */ + double cosz, rh, sinz; + + rh = hypot(xy.x, xy.y); + if ((lp.phi = rh * .5 ) > 1.) I_ERROR; + lp.phi = 2. * asin(lp.phi); + if (P->mode == OBLIQ || P->mode == EQUIT) { + sinz = sin(lp.phi); + cosz = cos(lp.phi); + } + switch (P->mode) { + case EQUIT: + lp.phi = fabs(rh) <= EPS10 ? 0. : asin(xy.y * sinz / rh); + xy.x *= sinz; + xy.y = cosz * rh; + break; + case OBLIQ: + lp.phi = fabs(rh) <= EPS10 ? P->phi0 : + asin(cosz * sinph0 + xy.y * sinz * cosph0 / rh); + xy.x *= sinz * cosph0; + xy.y = (cosz - sin(lp.phi) * sinph0) * rh; + break; + case N_POLE: + xy.y = -xy.y; + lp.phi = HALFPI - lp.phi; + break; + case S_POLE: + lp.phi -= HALFPI; + break; + } + lp.lam = (xy.y == 0. && (P->mode == EQUIT || P->mode == OBLIQ)) ? + 0. : atan2(xy.x, xy.y); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(laea) + double t; + + if (fabs((t = fabs(P->phi0)) - HALFPI) < EPS10) + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + else if (fabs(t) < EPS10) + P->mode = EQUIT; + else + P->mode = OBLIQ; + if (P->es) { + double sinphi; + + P->e = sqrt(P->es); + P->qp = pj_qsfn(1., P->e, P->one_es); + P->mmf = .5 / (1. - P->es); + P->apa = pj_authset(P->es); + switch (P->mode) { + case N_POLE: + case S_POLE: + P->dd = 1.; + break; + case EQUIT: + P->dd = 1. / (P->rq = sqrt(.5 * P->qp)); + P->xmf = 1.; + P->ymf = .5 * P->qp; + break; + case OBLIQ: + P->rq = sqrt(.5 * P->qp); + sinphi = sin(P->phi0); + P->sinb1 = pj_qsfn(sinphi, P->e, P->one_es) / P->qp; + P->cosb1 = sqrt(1. - P->sinb1 * P->sinb1); + P->dd = cos(P->phi0) / (sqrt(1. - P->es * sinphi * sinphi) * + P->rq * P->cosb1); + P->ymf = (P->xmf = P->rq) / P->dd; + P->xmf *= P->dd; + break; + } + P->inv = e_inverse; + P->fwd = e_forward; + } else { + if (P->mode == OBLIQ) { + sinph0 = sin(P->phi0); + cosph0 = cos(P->phi0); + } + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_lagrng.c b/src/PJ_lagrng.c new file mode 100644 index 00000000..a9de99c2 --- /dev/null +++ b/src/PJ_lagrng.c @@ -0,0 +1,38 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_lagrng.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double hrw; \ + double rw; \ + double a1; +#define TOL 1e-10 +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(lagrng, "Lagrange") "\n\tMisc Sph, no inv.\n\tW="; +FORWARD(s_forward); /* spheroid */ + double v, c; + + if (fabs(fabs(lp.phi) - HALFPI) < TOL) { + xy.x = 0; + xy.y = lp.phi < 0 ? -2. : 2.; + } else { + lp.phi = sin(lp.phi); + v = P->a1 * pow((1. + lp.phi)/(1. - lp.phi), P->hrw); + if ((c = 0.5 * (v + 1./v) + cos(lp.lam *= P->rw)) < TOL) + F_ERROR; + xy.x = 2. * sin(lp.lam) / c; + xy.y = (v - 1./v) / c; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(lagrng) + double phi1; + + if ((P->rw = pj_param(P->params, "dW").f) <= 0) E_ERROR(-27); + P->hrw = 0.5 * (P->rw = 1. / P->rw); + phi1 = pj_param(P->params, "rlat_1").f; + if (fabs(fabs(phi1 = sin(phi1)) - 1.) < TOL) E_ERROR(-22); + P->a1 = pow((1. - phi1)/(1. + phi1), P->hrw); + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_larr.c b/src/PJ_larr.c new file mode 100644 index 00000000..f44eab9f --- /dev/null +++ b/src/PJ_larr.c @@ -0,0 +1,15 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_larr.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(larr, "Larrivee") "\n\tMisc Sph, no inv."; +#define SIXTH .16666666666666666 +FORWARD(s_forward); /* sphere */ + xy.x = 0.5 * lp.lam * (1. + sqrt(cos(lp.phi))); + xy.y = lp.phi / (cos(0.5 * lp.phi) * cos(SIXTH * lp.lam)); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(larr) P->fwd = s_forward; P->inv = 0; P->es = 0.; ENDENTRY(P) diff --git a/src/PJ_lask.c b/src/PJ_lask.c new file mode 100644 index 00000000..34a61d94 --- /dev/null +++ b/src/PJ_lask.c @@ -0,0 +1,29 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_lask.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(lask, "Laskowski") "\n\tMisc Sph, no inv."; +#define a10 0.975534 +#define a12 -0.119161 +#define a32 -0.0143059 +#define a14 -0.0547009 +#define b01 1.00384 +#define b21 0.0802894 +#define b03 0.0998909 +#define b41 0.000199025 +#define b23 -0.0285500 +#define b05 -0.0491032 +FORWARD(s_forward); /* sphere */ + double l2, p2; + + l2 = lp.lam * lp.lam; + p2 = lp.phi * lp.phi; + xy.x = lp.lam * (a10 + p2 * (a12 + l2 * a32 + p2 * a14)); + xy.y = lp.phi * (b01 + l2 * (b21 + p2 * b23 + l2 * b41) + + p2 * (b03 + p2 * b05)); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(lask) P->fwd = s_forward; P->inv = 0; P->es = 0.; ENDENTRY(P) diff --git a/src/PJ_lcc.c b/src/PJ_lcc.c new file mode 100644 index 00000000..9e697cd9 --- /dev/null +++ b/src/PJ_lcc.c @@ -0,0 +1,106 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_lcc.c 4.2 94/03/18 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phi1; \ + double phi2; \ + double n; \ + double rho; \ + double rho0; \ + double c; \ + int ellips; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(lcc, "Lambert Conformal Conic") + "\n\tConic, Sph&Ell\n\tlat_1= and lat_2= or lat_0"; +# define EPS10 1.e-10 +FORWARD(e_forward); /* ellipsoid & spheroid */ + if (fabs(fabs(lp.phi) - HALFPI) < EPS10) { + if ((lp.phi * P->n) <= 0.) F_ERROR; + P->rho = 0.; + } + else + P->rho = P->c * (P->ellips ? pow(pj_tsfn(lp.phi, sin(lp.phi), + P->e), P->n) : pow(tan(FORTPI + .5 * lp.phi), -P->n)); + xy.x = P->k0 * (P->rho * sin( lp.lam *= P->n ) ); + xy.y = P->k0 * (P->rho0 - P->rho * cos(lp.lam) ); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid & spheroid */ + xy.x /= P->k0; + xy.y /= P->k0; + if (P->rho = hypot(xy.x, xy.y = P->rho0 - xy.y)) { + if (P->n < 0.) { + P->rho = -P->rho; + xy.x = -xy.x; + xy.y = -xy.y; + } + if (P->ellips) { + if ((lp.phi = pj_phi2(pow(P->rho / P->c, 1./P->n), P->e)) + == HUGE_VAL) + I_ERROR; + } else + lp.phi = 2. * atan(pow(P->c / P->rho, 1./P->n)) - HALFPI; + lp.lam = atan2(xy.x, xy.y) / P->n; + } else { + lp.lam = 0.; + lp.phi = P->n > 0. ? HALFPI : - HALFPI; + } + return (lp); +} +SPECIAL(fac) { + if (fabs(fabs(lp.phi) - HALFPI) < EPS10) { + if ((lp.phi * P->n) <= 0.) return; + P->rho = 0.; + } else + P->rho = P->c * (P->ellips ? pow(pj_tsfn(lp.phi, sin(lp.phi), + P->e), P->n) : pow(tan(FORTPI + .5 * lp.phi), -P->n)); + fac->code |= IS_ANAL_HK + IS_ANAL_CONV; + fac->k = fac->h = P->k0 * P->n * P->rho / + pj_msfn(sin(lp.phi), cos(lp.phi), P->es); + fac->conv = - P->n * lp.lam; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(lcc) + double cosphi, sinphi; + int secant; + + P->phi1 = pj_param(P->params, "rlat_1").f; + if (pj_param(P->params, "tlat_2").i) + P->phi2 = pj_param(P->params, "rlat_2").f; + else { + P->phi2 = P->phi1; + if (!pj_param(P->params, "tlat_0").i) + P->phi0 = P->phi1; + } + if (fabs(P->phi1 + P->phi2) < EPS10) E_ERROR(-21); + P->n = sinphi = sin(P->phi1); + cosphi = cos(P->phi1); + secant = fabs(P->phi1 - P->phi2) >= EPS10; + if (P->ellips = (P->es != 0.)) { + double ml1, m1; + + P->e = sqrt(P->es); + m1 = pj_msfn(sinphi, cosphi, P->es); + ml1 = pj_tsfn(P->phi1, sinphi, P->e); + if (secant) { /* secant cone */ + P->n = log(m1 / + pj_msfn(sinphi = sin(P->phi2), cos(P->phi2), P->es)); + P->n /= log(ml1 / pj_tsfn(P->phi2, sinphi, P->e)); + } + P->c = (P->rho0 = m1 * pow(ml1, -P->n) / P->n); + P->rho0 *= (fabs(fabs(P->phi0) - HALFPI) < EPS10) ? 0. : + pow(pj_tsfn(P->phi0, sin(P->phi0), P->e), P->n); + } else { + if (secant) + P->n = log(cosphi / cos(P->phi2)) / + log(tan(FORTPI + .5 * P->phi2) / + tan(FORTPI + .5 * P->phi1)); + P->c = cosphi * pow(tan(FORTPI + .5 * P->phi1), P->n) / P->n; + P->rho0 = (fabs(fabs(P->phi0) - HALFPI) < EPS10) ? 0. : + P->c * pow(tan(FORTPI + .5 * P->phi0), -P->n); + } + P->inv = e_inverse; + P->fwd = e_forward; + P->spc = fac; +ENDENTRY(P) diff --git a/src/PJ_loxim.c b/src/PJ_loxim.c new file mode 100644 index 00000000..4828d973 --- /dev/null +++ b/src/PJ_loxim.c @@ -0,0 +1,44 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_loxim.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phi1; \ + double cosphi1; \ + double tanphi1; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(loxim, "Loximuthal") "\n\tPCyl Sph"; +#define EPS 1e-8 +FORWARD(s_forward); /* spheroid */ + xy.y = lp.phi - P->phi1; + if (fabs(xy.y) < EPS) + xy.x = lp.lam * P->cosphi1; + else { + xy.x = FORTPI + 0.5 * lp.phi; + if (fabs(xy.x) < EPS || fabs(fabs(xy.x) - HALFPI) < EPS) + xy.x = 0.; + else + xy.x = lp.lam * xy.y / log( tan(xy.x) / P->tanphi1 ); + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y + P->phi1; + if (fabs(xy.y) < EPS) + lp.lam = xy.x / P->cosphi1; + else + if (fabs( lp.lam = FORTPI + 0.5 * lp.phi ) < EPS || + fabs(fabs(lp.lam) - HALFPI) < EPS) + lp.lam = 0.; + else + lp.lam = xy.x * log( tan(lp.lam) / P->tanphi1 ) / xy.y ; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(loxim); + P->phi1 = pj_param(P->params, "rlat_1").f; + if ((P->cosphi1 = cos(P->phi1)) < EPS) E_ERROR(-22); + P->tanphi1 = tan(FORTPI + 0.5 * P->phi1); + P->inv = s_inverse; P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_lsat.c b/src/PJ_lsat.c new file mode 100644 index 00000000..ddde1224 --- /dev/null +++ b/src/PJ_lsat.c @@ -0,0 +1,174 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_lsat.c 4.1 94/02/15 GIE REL"; +#endif +/* based upon Snyder and Linck, USGS-NMD */ +#define PROJ_PARMS__ \ + double a2, a4, b, c1, c3; \ + double q, t, u, w, p22, sa, ca, xj, rlm, rlm2; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(lsat, "Space oblique for LANDSAT") + "\n\tCyl, Sph&Ell\n\tlsat= path="; +#define TOL 1e-7 +#define PI_HALFPI 4.71238898038468985766 +#define TWOPI_HALFPI 7.85398163397448309610 + static void +seraz0(double lam, double mult, PJ *P) { + double sdsq, h, s, fc, sd, sq, d__1; + + lam *= DEG_TO_RAD; + sd = sin(lam); + sdsq = sd * sd; + s = P->p22 * P->sa * cos(lam) * sqrt((1. + P->t * sdsq) / (( + 1. + P->w * sdsq) * (1. + P->q * sdsq))); + d__1 = 1. + P->q * sdsq; + h = sqrt((1. + P->q * sdsq) / (1. + P->w * sdsq)) * ((1. + + P->w * sdsq) / (d__1 * d__1) - P->p22 * P->ca); + sq = sqrt(P->xj * P->xj + s * s); + P->b += fc = mult * (h * P->xj - s * s) / sq; + P->a2 += fc * cos(lam + lam); + P->a4 += fc * cos(lam * 4.); + fc = mult * s * (h + P->xj) / sq; + P->c1 += fc * cos(lam); + P->c3 += fc * cos(lam * 3.); +} +FORWARD(e_forward); /* ellipsoid */ + int l, nn; + double lamt, xlam, sdsq, c, d, s, lamdp, phidp, lampp, tanph, + lamtp, cl, sd, sp, fac, sav, tanphi; + + if (lp.phi > HALFPI) + lp.phi = HALFPI; + else if (lp.phi < -HALFPI) + lp.phi = -HALFPI; + lampp = lp.phi >= 0. ? HALFPI : PI_HALFPI; + tanphi = tan(lp.phi); + for (nn = 0;;) { + sav = lampp; + lamtp = lp.lam + P->p22 * lampp; + cl = cos(lamtp); + if (fabs(cl) < TOL) + lamtp -= TOL; + fac = lampp - sin(lampp) * (cl < 0. ? -HALFPI : HALFPI); + for (l = 50; l; --l) { + lamt = lp.lam + P->p22 * sav; + if (fabs(c = cos(lamt)) < TOL) + lamt -= TOL; + xlam = (P->one_es * tanphi * P->sa + sin(lamt) * P->ca) / c; + lamdp = atan(xlam) + fac; + if (fabs(fabs(sav) - fabs(lamdp)) < TOL) + break; + sav = lamdp; + } + if (!l || ++nn >= 3 || (lamdp > P->rlm && lamdp < P->rlm2)) + break; + if (lamdp <= P->rlm) + lampp = TWOPI_HALFPI; + else if (lamdp >= P->rlm2) + lampp = HALFPI; + } + if (l) { + sp = sin(lp.phi); + phidp = aasin((P->one_es * P->ca * sp - P->sa * cos(lp.phi) * + sin(lamt)) / sqrt(1. - P->es * sp * sp)); + tanph = log(tan(FORTPI + .5 * phidp)); + sd = sin(lamdp); + sdsq = sd * sd; + s = P->p22 * P->sa * cos(lamdp) * sqrt((1. + P->t * sdsq) + / ((1. + P->w * sdsq) * (1. + P->q * sdsq))); + d = sqrt(P->xj * P->xj + s * s); + xy.x = P->b * lamdp + P->a2 * sin(2. * lamdp) + P->a4 * + sin(lamdp * 4.) - tanph * s / d; + xy.y = P->c1 * sd + P->c3 * sin(lamdp * 3.) + tanph * P->xj / d; + } else + xy.x = xy.y = HUGE_VAL; + return xy; +} +INVERSE(e_inverse); /* ellipsoid */ + int nn; + double lamt, sdsq, s, lamdp, phidp, sppsq, dd, sd, sl, fac, scl, sav, spp; + + lamdp = xy.x / P->b; + nn = 50; + do { + sav = lamdp; + sd = sin(lamdp); + sdsq = sd * sd; + s = P->p22 * P->sa * cos(lamdp) * sqrt((1. + P->t * sdsq) + / ((1. + P->w * sdsq) * (1. + P->q * sdsq))); + lamdp = xy.x + xy.y * s / P->xj - P->a2 * sin( + 2. * lamdp) - P->a4 * sin(lamdp * 4.) - s / P->xj * ( + P->c1 * sin(lamdp) + P->c3 * sin(lamdp * 3.)); + lamdp /= P->b; + } while (fabs(lamdp - sav) >= TOL && --nn); + sl = sin(lamdp); + fac = exp(sqrt(1. + s * s / P->xj / P->xj) * (xy.y - + P->c1 * sl - P->c3 * sin(lamdp * 3.))); + phidp = 2. * (atan(fac) - FORTPI); + dd = sl * sl; + if (fabs(cos(lamdp)) < TOL) + lamdp -= TOL; + spp = sin(phidp); + sppsq = spp * spp; + lamt = atan(((1. - sppsq * P->rone_es) * tan(lamdp) * + P->ca - spp * P->sa * sqrt((1. + P->q * dd) * ( + 1. - sppsq) - sppsq * P->u) / cos(lamdp)) / (1. - sppsq + * (1. + P->u))); + sl = lamt >= 0. ? 1. : -1.; + scl = cos(lamdp) >= 0. ? 1. : -1; + lamt -= HALFPI * (1. - scl) * sl; + lp.lam = lamt - P->p22 * lamdp; + if (fabs(P->sa) < TOL) + lp.phi = aasin(spp / sqrt(P->one_es * P->one_es + P->es * sppsq)); + else + lp.phi = atan((tan(lamdp) * cos(lamt) - P->ca * sin(lamt)) / + (P->one_es * P->sa)); + return lp; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(lsat) + int land, path; + double lam, alf, esc, ess; + + land = pj_param(P->params, "ilsat").i; + if (land <= 0 || land > 5) E_ERROR(-28); + path = pj_param(P->params, "ipath").i; + if (path <= 0 || path > (land <= 3 ? 251 : 233)) E_ERROR(-29); + if (land <= 3) { + P->lam0 = DEG_TO_RAD * 128.87 - TWOPI / 251. * path; + P->p22 = 103.2669323; + alf = DEG_TO_RAD * 99.092; + } else { + P->lam0 = DEG_TO_RAD * 129.3 - TWOPI / 233. * path; + P->p22 = 98.8841202; + alf = DEG_TO_RAD * 98.2; + } + P->p22 /= 1440.; + P->sa = sin(alf); + P->ca = cos(alf); + if (fabs(P->ca) < 1e-9) + P->ca = 1e-9; + esc = P->es * P->ca * P->ca; + ess = P->es * P->sa * P->sa; + P->w = (1. - esc) * P->rone_es; + P->w = P->w * P->w - 1.; + P->q = ess * P->rone_es; + P->t = ess * (2. - P->es) * P->rone_es * P->rone_es; + P->u = esc * P->rone_es; + P->xj = P->one_es * P->one_es * P->one_es; + P->rlm = PI * (1. / 248. + .5161290322580645); + P->rlm2 = P->rlm + TWOPI; + P->a2 = P->a4 = P->b = P->c1 = P->c3 = 0.; + seraz0(0., 1., P); + for (lam = 9.; lam <= 81.0001; lam += 18.) + seraz0(lam, 4., P); + for (lam = 18; lam <= 72.0001; lam += 18.) + seraz0(lam, 2., P); + seraz0(90., 1., P); + P->a2 /= 30.; + P->a4 /= 60.; + P->b /= 30.; + P->c1 /= 15.; + P->c3 /= 45.; + P->inv = e_inverse; P->fwd = e_forward; +ENDENTRY(P) diff --git a/src/PJ_mbt_fps.c b/src/PJ_mbt_fps.c new file mode 100644 index 00000000..35fb7320 --- /dev/null +++ b/src/PJ_mbt_fps.c @@ -0,0 +1,41 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mbt_fps.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(mbt_fps, "McBryde-Thomas Flat-Pole Sine (No. 2)") "\n\tCyl., Sph."; +#define MAX_ITER 10 +#define LOOP_TOL 1e-7 +#define C1 0.45503 +#define C2 1.36509 +#define C3 1.41546 +#define C_x 0.22248 +#define C_y 1.44492 +#define C1_2 0.33333333333333333333333333 +FORWARD(s_forward); /* spheroid */ + double k, V, t; + int i; + + k = C3 * sin(lp.phi); + for (i = MAX_ITER; i ; --i) { + t = lp.phi / C2; + lp.phi -= V = (C1 * sin(t) + sin(lp.phi) - k) / + (C1_2 * cos(t) + cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + t = lp.phi / C2; + xy.x = C_x * lp.lam * (1. + 3. * cos(lp.phi)/cos(t) ); + xy.y = C_y * sin(t); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t, s; + + lp.phi = C2 * (t = aasin(xy.y / C_y)); + lp.lam = xy.x / (C_x * (1. + 3. * cos(lp.phi)/cos(t))); + lp.phi = aasin((C1 * sin(t) + sin(lp.phi)) / C3); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(mbt_fps) P->es = 0; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_mbtfpp.c b/src/PJ_mbtfpp.c new file mode 100644 index 00000000..d2f8f18b --- /dev/null +++ b/src/PJ_mbtfpp.c @@ -0,0 +1,35 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mbtfpp.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(mbtfpp, "McBride-Thomas Flat-Polar Parabolic") "\n\tCyl., Sph."; +#define CS .95257934441568037152 +#define FXC .92582009977255146156 +#define FYC 3.40168025708304504493 +#define C23 .66666666666666666666 +#define C13 .33333333333333333333 +#define ONEEPS 1.0000001 +FORWARD(s_forward); /* spheroid */ + lp.phi = asin(CS * sin(lp.phi)); + xy.x = FXC * lp.lam * (2. * cos(C23 * lp.phi) - 1.); + xy.y = FYC * sin(C13 * lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / FYC; + if (fabs(lp.phi) >= 1.) { + if (fabs(lp.phi) > ONEEPS) I_ERROR + else lp.phi = (lp.phi < 0.) ? -HALFPI : HALFPI; + } else + lp.phi = asin(lp.phi); + lp.lam = xy.x / ( FXC * (2. * cos(C23 * (lp.phi *= 3.)) - 1.) ); + if (fabs(lp.phi = sin(lp.phi) / CS) >= 1.) { + if (fabs(lp.phi) > ONEEPS) I_ERROR + else lp.phi = (lp.phi < 0.) ? -HALFPI : HALFPI; + } else + lp.phi = asin(lp.phi); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(mbtfpp) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_mbtfpq.c b/src/PJ_mbtfpq.c new file mode 100644 index 00000000..9827ffcc --- /dev/null +++ b/src/PJ_mbtfpq.c @@ -0,0 +1,50 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mbtfpq.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(mbtfpq, "McBryde-Thomas Flat-Polar Quartic") "\n\tCyl., Sph."; +#define NITER 20 +#define EPS 1e-7 +#define ONETOL 1.000001 +#define C 1.70710678118654752440 +#define RC 0.58578643762690495119 +#define FYC 1.87475828462269495505 +#define RYC 0.53340209679417701685 +#define FXC 0.31245971410378249250 +#define RXC 3.20041258076506210122 +FORWARD(s_forward); /* spheroid */ + double th1, c; + int i; + + c = C * sin(lp.phi); + for (i = NITER; i; --i) { + lp.phi -= th1 = (sin(.5*lp.phi) + sin(lp.phi) - c) / + (.5*cos(.5*lp.phi) + cos(lp.phi)); + if (fabs(th1) < EPS) break; + } + xy.x = FXC * lp.lam * (1.0 + 2. * cos(lp.phi)/cos(0.5 * lp.phi)); + xy.y = FYC * sin(0.5 * lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t; + + lp.phi = RYC * xy.y; + if (fabs(lp.phi) > 1.) { + if (fabs(lp.phi) > ONETOL) I_ERROR + else if (lp.phi < 0.) { t = -1.; lp.phi = -PI; } + else { t = 1.; lp.phi = PI; } + } else + lp.phi = 2. * asin(t = lp.phi); + lp.lam = RXC * xy.x / (1. + 2. * cos(lp.phi)/cos(0.5 * lp.phi)); + lp.phi = RC * (t + sin(lp.phi)); + if (fabs(lp.phi) > 1.) + if (fabs(lp.phi) > ONETOL) I_ERROR + else lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + else + lp.phi = asin(lp.phi); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(mbtfpq) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_merc.c b/src/PJ_merc.c new file mode 100644 index 00000000..63bc3341 --- /dev/null +++ b/src/PJ_merc.c @@ -0,0 +1,50 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_merc.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(merc, "Mercator") "\n\tCyl, Sph&Ell\n\tlat_ts="; +#define EPS10 1.e-10 +FORWARD(e_forward); /* ellipsoid */ + if (fabs(fabs(lp.phi) - HALFPI) <= EPS10) F_ERROR; + xy.x = P->k0 * lp.lam; + xy.y = - P->k0 * log(pj_tsfn(lp.phi, sin(lp.phi), P->e)); + return (xy); +} +FORWARD(s_forward); /* spheroid */ + if (fabs(fabs(lp.phi) - HALFPI) <= EPS10) F_ERROR; + xy.x = P->k0 * lp.lam; + xy.y = P->k0 * log(tan(FORTPI + .5 * lp.phi)); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + if ((lp.phi = pj_phi2(exp(- xy.y / P->k0), P->e)) == HUGE_VAL) I_ERROR; + lp.lam = xy.x / P->k0; + return (lp); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = HALFPI - 2. * atan(exp(-xy.y / P->k0)); + lp.lam = xy.x / P->k0; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(merc) + double phits; + int is_phits; + + if (is_phits = pj_param(P->params, "tlat_ts").i) { + phits = fabs(pj_param(P->params, "rlat_ts").f); + if (phits >= HALFPI) E_ERROR(-24); + } + if (P->es) { /* ellipsoid */ + if (is_phits) + P->k0 = pj_msfn(sin(phits), cos(phits), P->es); + P->inv = e_inverse; + P->fwd = e_forward; + } else { /* sphere */ + if (is_phits) + P->k0 = cos(phits); + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_mill.c b/src/PJ_mill.c new file mode 100644 index 00000000..a9e40a74 --- /dev/null +++ b/src/PJ_mill.c @@ -0,0 +1,18 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mill.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(mill, "Miller Cylindrical") "\n\tCyl, Sph"; +FORWARD(s_forward); /* spheroid */ + xy.x = lp.lam; + xy.y = log(tan(FORTPI + lp.phi * .4)) * 1.25; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.lam = xy.x; + lp.phi = 2.5 * (atan(exp(.8 * xy.y)) - FORTPI); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(mill) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_mod_ster.c b/src/PJ_mod_ster.c new file mode 100644 index 00000000..04fecb68 --- /dev/null +++ b/src/PJ_mod_ster.c @@ -0,0 +1,214 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mod_ster.c 4.1 94/02/15 GIE REL"; +#endif +/* based upon Snyder and Linck, USGS-NMD */ +#define PROJ_PARMS__ \ + COMPLEX *zcoeff; \ + double cchio, schio; \ + int n; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(mil_os, "Miller Oblated Stereographic") "\n\tAzi(mod)"; +PROJ_HEAD(lee_os, "Lee Oblated Stereographic") "\n\tAzi(mod)"; +PROJ_HEAD(gs48, "Mod. Stererographics of 48 U.S.") "\n\tAzi(mod)"; +PROJ_HEAD(alsk, "Mod. Stererographics of Alaska") "\n\tAzi(mod)"; +PROJ_HEAD(gs50, "Mod. Stererographics of 50 U.S.") "\n\tAzi(mod)"; +#define EPSLN 1e-10 + +FORWARD(e_forward); /* ellipsoid */ + double sinlon, coslon, esphi, chi, schi, cchi, s; + COMPLEX p; + + sinlon = sin(lp.lam); + coslon = cos(lp.lam); + esphi = P->e * sin(lp.phi); + chi = 2. * atan(tan((HALFPI + lp.phi) * .5) * + pow((1. - esphi) / (1. + esphi), P->e * .5)) - HALFPI; + schi = sin(chi); + cchi = cos(chi); + s = 2. / (1. + P->schio * schi + P->cchio * cchi * coslon); + p.r = s * cchi * sinlon; + p.i = s * (P->cchio * schi - P->schio * cchi * coslon); + p = pj_zpoly1(p, P->zcoeff, P->n); + xy.x = p.r; + xy.y = p.i; + return xy; +} +INVERSE(e_inverse); /* ellipsoid */ + int nn; + COMPLEX p, fxy, fpxy, dp; + double den, rh, z, sinz, cosz, chi, phi, dphi, esphi; + + p.r = xy.x; + p.i = xy.y; + for (nn = 20; nn ;--nn) { + fxy = pj_zpolyd1(p, P->zcoeff, P->n, &fpxy); + fxy.r -= xy.x; + fxy.i -= xy.y; + den = fpxy.r * fpxy.r + fpxy.i * fpxy.i; + dp.r = -(fxy.r * fpxy.r + fxy.i * fpxy.i) / den; + dp.i = -(fxy.i * fpxy.r - fxy.r * fpxy.i) / den; + p.r += dp.r; + p.i += dp.i; + if ((fabs(dp.r) + fabs(dp.i)) <= EPSLN) + break; + } + if (nn) { + rh = hypot(p.r, p.i); + z = 2. * atan(.5 * rh); + sinz = sin(z); + cosz = cos(z); + lp.lam = P->lam0; + if (fabs(rh) <= EPSLN) { + lp.phi = P->phi0; + return lp; + } + chi = aasin(cosz * P->schio + p.i * sinz * P->cchio / rh); + phi = chi; + for (nn = 20; nn ;--nn) { + esphi = P->e * sin(phi); + dphi = 2. * atan(tan((HALFPI + chi) * .5) * + pow((1. + esphi) / (1. - esphi), P->e * .5)) - HALFPI - phi; + phi += dphi; + if (fabs(dphi) <= EPSLN) + break; + } + } + if (nn) { + lp.phi = phi; + lp.lam = atan2(p.r * sinz, rh * P->cchio * cosz - p.i * + P->schio * sinz); + } else + lp.lam = lp.phi = HUGE_VAL; + return lp; +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { /* general initialization */ + double esphi, chio; + + if (P->es) { + esphi = P->e * sin(P->phi0); + chio = 2. * atan(tan((HALFPI + P->phi0) * .5) * + pow((1. - esphi) / (1. + esphi), P->e * .5)) - HALFPI; + } else + chio = P->phi0; + P->schio = sin(chio); + P->cchio = cos(chio); + P->inv = e_inverse; P->fwd = e_forward; + return P; +} +ENTRY0(mil_os) + static COMPLEX /* Miller Oblated Stereographic */ +AB[] = { + 0.924500, 0., + 0., 0., + 0.019430, 0. +}; + + P->n = 2; + P->lam0 = DEG_TO_RAD * 20.; + P->phi0 = DEG_TO_RAD * 18.; + P->zcoeff = AB; + P->es = 0.; +ENDENTRY(setup(P)) +ENTRY0(lee_os) + static COMPLEX /* Lee Oblated Stereographic */ +AB[] = { + 0.721316, 0., + 0., 0., + -0.0088162, -0.00617325 +}; + + P->n = 2; + P->lam0 = DEG_TO_RAD * -165.; + P->phi0 = DEG_TO_RAD * -10.; + P->zcoeff = AB; + P->es = 0.; +ENDENTRY(setup(P)) +ENTRY0(gs48) + static COMPLEX /* 48 United States */ +AB[] = { + 0.98879, 0., + 0., 0., + -0.050909, 0., + 0., 0., + 0.075528, 0. +}; + + P->n = 4; + P->lam0 = DEG_TO_RAD * -96.; + P->phi0 = DEG_TO_RAD * -39.; + P->zcoeff = AB; + P->es = 0.; + P->a = 6370997.; +ENDENTRY(setup(P)) +ENTRY0(alsk) + static COMPLEX +ABe[] = { /* Alaska ellipsoid */ + .9945303, 0., + .0052083, -.0027404, + .0072721, .0048181, + -.0151089, -.1932526, + .0642675, -.1381226, + .3582802, -.2884586}, +ABs[] = { /* Alaska sphere */ + .9972523, 0., + .0052513, -.0041175, + .0074606, .0048125, + -.0153783, -.1968253, + .0636871, -.1408027, + .3660976, -.2937382 +}; + + P->n = 5; + P->lam0 = DEG_TO_RAD * -152.; + P->phi0 = DEG_TO_RAD * 64.; + if (P->es) { /* fixed ellipsoid/sphere */ + P->zcoeff = ABe; + P->a = 6378206.4; + P->e = sqrt(P->es = 0.00676866); + } else { + P->zcoeff = ABs; + P->a = 6370997.; + } +ENDENTRY(setup(P)) +ENTRY0(gs50) + static COMPLEX +ABe[] = { /* GS50 ellipsoid */ + .9827497, 0., + .0210669, .0053804, + -.1031415, -.0571664, + -.0323337, -.0322847, + .0502303, .1211983, + .0251805, .0895678, + -.0012315, -.1416121, + .0072202, -.1317091, + -.0194029, .0759677, + -.0210072, .0834037 +}, +ABs[] = { /* GS50 sphere */ + .9842990, 0., + .0211642, .0037608, + -.1036018, -.0575102, + -.0329095, -.0320119, + .0499471, .1223335, + .0260460, .0899805, + .0007388, -.1435792, + .0075848, -.1334108, + -.0216473, .0776645, + -.0225161, .0853673 +}; + + P->n = 9; + P->lam0 = DEG_TO_RAD * -120.; + P->phi0 = DEG_TO_RAD * 45.; + if (P->es) { /* fixed ellipsoid/sphere */ + P->zcoeff = ABe; + P->a = 6378206.4; + P->e = sqrt(P->es = 0.00676866); + } else { + P->zcoeff = ABs; + P->a = 6370997.; + } +ENDENTRY(setup(P)) diff --git a/src/PJ_moll.c b/src/PJ_moll.c new file mode 100644 index 00000000..35d61b67 --- /dev/null +++ b/src/PJ_moll.c @@ -0,0 +1,65 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_moll.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x, C_y, C_p; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(moll, "Mollweide") "\n\tPCyl., Sph."; +PROJ_HEAD(wag4, "Wagner IV") "\n\tPCyl., Sph."; +PROJ_HEAD(wag5, "Wagner V") "\n\tPCyl., Sph."; +#define MAX_ITER 10 +#define LOOP_TOL 1e-7 +FORWARD(s_forward); /* spheroid */ + double k, V; + int i; + + k = P->C_p * sin(lp.phi); + for (i = MAX_ITER; i ; --i) { + lp.phi -= V = (lp.phi + sin(lp.phi) - k) / + (1. + cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + if (!i) + lp.phi = (lp.phi < 0.) ? -HALFPI : HALFPI; + else + lp.phi *= 0.5; + xy.x = P->C_x * lp.lam * cos(lp.phi); + xy.y = P->C_y * sin(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double th, s; + + lp.phi = aasin(xy.y / P->C_y); + lp.lam = xy.x / (P->C_x * cos(lp.phi)); + lp.phi += lp.phi; + lp.phi = aasin((lp.phi + sin(lp.phi)) / P->C_p); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P, double p) { + double r, sp, p2 = p + p; + + P->es = 0; + sp = sin(p); + r = sqrt(TWOPI * sp / (p2 + sin(p2))); + P->C_x = 2. * r / PI; + P->C_y = r / sp; + P->C_p = p2 + sin(p2); + P->inv = s_inverse; + P->fwd = s_forward; + return P; +} +ENTRY0(moll) ENDENTRY(setup(P, HALFPI)) +ENTRY0(wag4) ENDENTRY(setup(P, PI/3.)) +ENTRY0(wag5) + P->es = 0; + P->C_x = 0.90977; + P->C_y = 1.65014; + P->C_p = 3.00896; + P->inv = s_inverse; + P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_mpoly.c b/src/PJ_mpoly.c new file mode 100644 index 00000000..4b566993 --- /dev/null +++ b/src/PJ_mpoly.c @@ -0,0 +1,21 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_mpoly.c 4.1 94/05/22 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double rho_0; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(mpoly, "Modified Polyconic") + "\n\tPolyconic, Sph\n\tlat_1= and lat_2= lotsa"; +FORWARD(s_forward); /* spheroid */ + return (xy); +} +INVERSE(s_inverse); /* ellipsoid & spheroid */ + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(mpoly) + P->fwd = s_forward; + P->inv = s_inverse; + P->es = 0; +ENDENTRY(P) diff --git a/src/PJ_nell.c b/src/PJ_nell.c new file mode 100644 index 00000000..9473eff4 --- /dev/null +++ b/src/PJ_nell.c @@ -0,0 +1,34 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_nell.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(nell, "Nell") "\n\tPCyl., Sph."; +#define MAX_ITER 10 +#define LOOP_TOL 1e-7 +FORWARD(s_forward); /* spheroid */ + double k, V; + int i; + + k = 2. * sin(lp.phi); + V = lp.phi * lp.phi; + lp.phi *= 1.00371 + V * (-0.0935382 + V * -0.011412); + for (i = MAX_ITER; i ; --i) { + lp.phi -= V = (lp.phi + sin(lp.phi) - k) / + (1. + cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + xy.x = 0.5 * lp.lam * (1. + cos(lp.phi)); + xy.y = lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double th, s; + + lp.lam = 2. * xy.x / (1. + cos(xy.y)); + lp.phi = aasin(0.5 * (xy.y + sin(xy.y))); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(nell) P->es = 0; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_nell_h.c b/src/PJ_nell_h.c new file mode 100644 index 00000000..3e87abec --- /dev/null +++ b/src/PJ_nell_h.c @@ -0,0 +1,33 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_nell_h.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(nell_h, "Nell-Hammer") "\n\tPCyl., Sph."; +#define NITER 9 +#define EPS 1e-7 +FORWARD(s_forward); /* spheroid */ + xy.x = 0.5 * lp.lam * (1. + cos(lp.phi)); + xy.y = 2.0 * (lp.phi - tan(0.5 *lp.phi)); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double V, c, p; + int i; + + p = 0.5 * xy.y; + for (i = NITER; i ; --i) { + c = cos(0.5 * lp.phi); + lp.phi -= V = (lp.phi - tan(lp.phi/2) - p)/(1. - 0.5/(c*c)); + if (fabs(V) < EPS) + break; + } + if (!i) { + lp.phi = p < 0. ? -HALFPI : HALFPI; + lp.lam = 2. * xy.x; + } else + lp.lam = 2. * xy.x / (1. + cos(lp.phi)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(nell_h) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_nocol.c b/src/PJ_nocol.c new file mode 100644 index 00000000..d9aec5ad --- /dev/null +++ b/src/PJ_nocol.c @@ -0,0 +1,41 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_nocol.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(nicol, "Nicolosi Globular") "\n\tMisc Sph, no inv."; +#define EPS 1e-10 +FORWARD(s_forward); /* spheroid */ + if (fabs(lp.lam) < EPS) { + xy.x = 0; + xy.y = lp.phi; + } else if (fabs(lp.phi) < EPS) { + xy.x = lp.lam; + xy.y = 0.; + } else if (fabs(fabs(lp.lam) - HALFPI) < EPS) { + xy.x = lp.lam * cos(lp.phi); + xy.y = HALFPI * sin(lp.phi); + } else if (fabs(fabs(lp.phi) - HALFPI) < EPS) { + xy.x = 0; + xy.y = lp.phi; + } else { + double tb, c, d, m, n, r2, sp; + + tb = HALFPI / lp.lam - lp.lam / HALFPI; + c = lp.phi / HALFPI; + d = (1 - c * c)/((sp = sin(lp.phi)) - c); + r2 = tb / d; + r2 *= r2; + m = (tb * sp / d - 0.5 * tb)/(1. + r2); + n = (sp / r2 + 0.5 * d)/(1. + 1./r2); + xy.x = cos(lp.phi); + xy.x = sqrt(m * m + xy.x * xy.x / (1. + r2)); + xy.x = HALFPI * ( m + (lp.lam < 0. ? -xy.x : xy.x)); + xy.y = sqrt(n * n - (sp * sp / r2 + d * sp - 1.) / + (1. + 1./r2)); + xy.y = HALFPI * ( n + (lp.phi < 0. ? xy.y : -xy.y )); + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(nicol) P->es = 0.; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_nsper.c b/src/PJ_nsper.c new file mode 100644 index 00000000..6b430a84 --- /dev/null +++ b/src/PJ_nsper.c @@ -0,0 +1,152 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_nsper.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double height; \ + double sinph0; \ + double cosph0; \ + double p; \ + double rp; \ + double pn1; \ + double pfact; \ + double h; \ + double cg; \ + double sg; \ + double sw; \ + double cw; \ + int mode; \ + int tilt; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(nsper, "Near-sided perspective") "\n\tAzi, Sph\n\th="; +PROJ_HEAD(tpers, "Tilted perspective") "\n\tAzi, Sph\n\ttilt= azi= h="; +# define EPS10 1.e-10 +# define N_POLE 0 +# define S_POLE 1 +# define EQUIT 2 +# define OBLIQ 3 +FORWARD(s_forward); /* spheroid */ + double coslam, cosphi, sinphi; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + switch (P->mode) { + case OBLIQ: + xy.y = P->sinph0 * sinphi + P->cosph0 * cosphi * coslam; + break; + case EQUIT: + xy.y = cosphi * coslam; + break; + case S_POLE: + xy.y = - sinphi; + break; + case N_POLE: + xy.y = sinphi; + break; + } + if (xy.y < P->rp) F_ERROR; + xy.y = P->pn1 / (P->p - xy.y); + xy.x = xy.y * cosphi * sin(lp.lam); + switch (P->mode) { + case OBLIQ: + xy.y *= (P->cosph0 * sinphi - + P->sinph0 * cosphi * coslam); + break; + case EQUIT: + xy.y *= sinphi; + break; + case N_POLE: + coslam = - coslam; + case S_POLE: + xy.y *= cosphi * coslam; + break; + } + if (P->tilt) { + double yt, ba; + + yt = xy.y * P->cg + xy.x * P->sg; + ba = 1. / (yt * P->sw * P->h + P->cw); + xy.x = (xy.x * P->cg - xy.y * P->sg) * P->cw * ba; + xy.y = yt * ba; + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double rh, cosz, sinz; + + if (P->tilt) { + double bm, bq, yt; + + yt = 1./(P->pn1 - xy.y * P->sw); + bm = P->pn1 * xy.x * yt; + bq = P->pn1 * xy.y * P->cw * yt; + xy.x = bm * P->cg + bq * P->sg; + xy.y = bq * P->cg - bm * P->sg; + } + rh = hypot(xy.x, xy.y); + if ((sinz = 1. - rh * rh * P->pfact) < 0.) I_ERROR; + sinz = (P->p - sqrt(sinz)) / (P->pn1 / rh + rh / P->pn1); + cosz = sqrt(1. - sinz * sinz); + if (fabs(rh) <= EPS10) { + lp.lam = 0.; + lp.phi = P->phi0; + } else { + switch (P->mode) { + case OBLIQ: + lp.phi = asin(cosz * P->sinph0 + xy.y * sinz * P->cosph0 / rh); + xy.y = (cosz - P->sinph0 * sin(lp.phi)) * rh; + xy.x *= sinz * P->cosph0; + break; + case EQUIT: + lp.phi = asin(xy.y * sinz / rh); + xy.y = cosz * rh; + xy.x *= sinz; + break; + case N_POLE: + lp.phi = asin(cosz); + xy.y = -xy.y; + break; + case S_POLE: + lp.phi = - asin(cosz); + break; + } + lp.lam = atan2(xy.x, xy.y); + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + if ((P->height = pj_param(P->params, "dh").f) <= 0.) E_ERROR(-30); + if (fabs(fabs(P->phi0) - HALFPI) < EPS10) + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + else if (fabs(P->phi0) < EPS10) + P->mode = EQUIT; + else { + P->mode = OBLIQ; + P->sinph0 = sin(P->phi0); + P->cosph0 = cos(P->phi0); + } + P->pn1 = P->height / P->a; /* normalize by radius */ + P->p = 1. + P->pn1; + P->rp = 1. / P->p; + P->h = 1. / P->pn1; + P->pfact = (P->p + 1.) * P->h; + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; + return P; +} +ENTRY0(nsper) + P->tilt = 0; +ENDENTRY(setup(P)) +ENTRY0(tpers) + double omega, gamma; + + omega = pj_param(P->params, "dtilt").f * DEG_TO_RAD; + gamma = pj_param(P->params, "dazi").f * DEG_TO_RAD; + P->tilt = 1; + P->cg = cos(gamma); P->sg = sin(gamma); + P->cw = cos(omega); P->sw = sin(omega); +ENDENTRY(setup(P)) diff --git a/src/PJ_nzmg.c b/src/PJ_nzmg.c new file mode 100644 index 00000000..fabe32a1 --- /dev/null +++ b/src/PJ_nzmg.c @@ -0,0 +1,77 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_nzmg.c 4.1 94/02/15 GIE REL"; +#endif +/* very loosely based upon DMA code by Bradford W. Drew */ +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(nzmg, "New Zealand Map Grid") "\n\tfixed Earth"; +#define EPSLN 1e-10 +#define SEC5_TO_RAD 0.4848136811095359935899141023 +#define RAD_TO_SEC5 2.062648062470963551564733573 + static COMPLEX +bf[] = { + .7557853228, 0.0, + .249204646, .003371507, + -.001541739, .041058560, + -.10162907, .01727609, + -.26623489, -.36249218, + -.6870983, -1.1651967 }; + static double +tphi[] = { 1.5627014243, .5185406398, -.03333098, -.1052906, -.0368594, + .007317, .01220, .00394, -.0013 }, +tpsi[] = { .6399175073, -.1358797613, .063294409, -.02526853, .0117879, + -.0055161, .0026906, -.001333, .00067, -.00034 }; +#define Nbf 5 +#define Ntpsi 9 +#define Ntphi 8 +FORWARD(e_forward); /* ellipsoid */ + COMPLEX p; + double *C; + int i; + + lp.phi = (lp.phi - P->phi0) * RAD_TO_SEC5; + for (p.r = *(C = tpsi + (i = Ntpsi)); i ; --i) + p.r = *--C + lp.phi * p.r; + p.r *= lp.phi; + p.i = lp.lam; + p = pj_zpoly1(p, bf, Nbf); + xy.x = p.i; + xy.y = p.r; + return xy; +} +INVERSE(e_inverse); /* ellipsoid */ + int nn, i; + COMPLEX p, f, fp, dp; + double den, *C; + + p.r = xy.y; + p.i = xy.x; + for (nn = 20; nn ;--nn) { + f = pj_zpolyd1(p, bf, Nbf, &fp); + f.r -= xy.y; + f.i -= xy.x; + den = fp.r * fp.r + fp.i * fp.i; + p.r += dp.r = -(f.r * fp.r + f.i * fp.i) / den; + p.i += dp.i = -(f.i * fp.r - f.r * fp.i) / den; + if ((fabs(dp.r) + fabs(dp.i)) <= EPSLN) + break; + } + if (nn) { + lp.lam = p.i; + for (lp.phi = *(C = tphi + (i = Ntphi)); i ; --i) + lp.phi = *--C + p.r * lp.phi; + lp.phi = P->phi0 + p.r * lp.phi * SEC5_TO_RAD; + } else + lp.lam = lp.phi = HUGE_VAL; + return lp; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(nzmg) + /* force to International major axis */ + P->ra = 1. / (P->a = 6378388.0); + P->lam0 = DEG_TO_RAD * 173.; + P->phi0 = DEG_TO_RAD * -41.; + P->x0 = 2510000.; + P->y0 = 6023150.; + P->inv = e_inverse; P->fwd = e_forward; +ENDENTRY(P) diff --git a/src/PJ_ob_tran.c b/src/PJ_ob_tran.c new file mode 100644 index 00000000..d02878c9 --- /dev/null +++ b/src/PJ_ob_tran.c @@ -0,0 +1,142 @@ +#ifndef lint +static char SCCSID[]="@(#)PJ_ob_tran.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + struct PJconsts *link; \ + double lamp; \ + double cphip, sphip; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(ob_tran, "General Oblique Transformation") "\n\tMisc Sph" +"\n\to_proj= plus parameters for projection" +"\n\to_lat_p= o_lon_p= (new pole) or" +"\n\to_alpha= o_lon_c= o_lat_c= or" +"\n\to_lon_1= o_lat_1= o_lon_2= o_lat_2="; +#define TOL 1e-10 +FORWARD(o_forward); /* spheroid */ + double coslam, sinphi, cosphi; + + coslam = cos(lp.lam); + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + lp.lam = adjlon(aatan2(cosphi * sin(lp.lam), P->sphip * cosphi * coslam + + P->cphip * sinphi) + P->lamp); + lp.phi = aasin(P->sphip * sinphi - P->cphip * cosphi * coslam); + return (P->link->fwd(lp, P->link)); +} +FORWARD(t_forward); /* spheroid */ + double cosphi, coslam; + + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + lp.lam = adjlon(aatan2(cosphi * sin(lp.lam), sin(lp.phi)) + P->lamp); + lp.phi = aasin(- cosphi * coslam); + return (P->link->fwd(lp, P->link)); +} +INVERSE(o_inverse); /* spheroid */ + double coslam, sinphi, cosphi; + + lp = P->link->inv(xy, P->link); + if (lp.lam != HUGE_VAL) { + coslam = cos(lp.lam -= P->lamp); + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + lp.phi = aasin(P->sphip * sinphi + P->cphip * cosphi * coslam); + lp.lam = aatan2(cosphi * sin(lp.lam), P->sphip * cosphi * coslam - + P->cphip * sinphi); + } + return (lp); +} +INVERSE(t_inverse); /* spheroid */ + double cosphi, t; + + lp = P->link->inv(xy, P->link); + if (lp.lam != HUGE_VAL) { + cosphi = cos(lp.phi); + t = lp.lam - P->lamp; + lp.lam = aatan2(cosphi * sin(t), - sin(lp.phi)); + lp.phi = aasin(cosphi * cos(t)); + } + return (lp); +} +FREEUP; + if (P) { + if (P->link) + (*(P->link->pfree))(P->link); + pj_dalloc(P); + } +} +ENTRY1(ob_tran, link) + int i; + double phip; + char *name, *s; + + /* get name of projection to be translated */ + if (!(name = pj_param(P->params, "so_proj").s)) E_ERROR(-26); + for (i = 0; (s = pj_list[i].id) && strcmp(name, s) ; ++i) ; + if (!s || !(P->link = (*pj_list[i].proj)(0))) E_ERROR(-37); + /* copy existing header into new */ + P->es = 0.; /* force to spherical */ + P->link->params = P->params; + P->link->over = P->over; + P->link->geoc = P->geoc; + P->link->a = P->a; + P->link->es = P->es; + P->link->ra = P->ra; + P->link->lam0 = P->lam0; + P->link->phi0 = P->phi0; + P->link->x0 = P->x0; + P->link->y0 = P->y0; + P->link->k0 = P->k0; + /* force spherical earth */ + P->link->one_es = P->link->rone_es = 1.; + P->link->es = P->link->e = 0.; + if (!(P->link = pj_list[i].proj(P->link))) { + freeup(P); + return 0; + } + if (pj_param(P->params, "to_alpha").i) { + double lamc, phic, alpha; + + lamc = pj_param(P->params, "ro_lon_c").f; + phic = pj_param(P->params, "ro_lat_c").f; + alpha = pj_param(P->params, "ro_alpha").f; +/* + if (fabs(phic) <= TOL || + fabs(fabs(phic) - HALFPI) <= TOL || + fabs(fabs(alpha) - HALFPI) <= TOL) +*/ + if (fabs(fabs(phic) - HALFPI) <= TOL) + E_ERROR(-32); + P->lamp = lamc + aatan2(-cos(alpha), -sin(alpha) * sin(phic)); + phip = aasin(cos(phic) * sin(alpha)); + } else if (pj_param(P->params, "to_lat_p").i) { /* specified new pole */ + P->lamp = pj_param(P->params, "ro_lon_p").f; + phip = pj_param(P->params, "ro_lat_p").f; + } else { /* specified new "equator" points */ + double lam1, lam2, phi1, phi2, con; + + lam1 = pj_param(P->params, "ro_lon_1").f; + phi1 = pj_param(P->params, "ro_lat_1").f; + lam2 = pj_param(P->params, "ro_lon_2").f; + phi2 = pj_param(P->params, "ro_lat_2").f; + if (fabs(phi1 - phi2) <= TOL || + (con = fabs(phi1)) <= TOL || + fabs(con - HALFPI) <= TOL || + fabs(fabs(phi2) - HALFPI) <= TOL) E_ERROR(-33); + P->lamp = atan2(cos(phi1) * sin(phi2) * cos(lam1) - + sin(phi1) * cos(phi2) * cos(lam2), + sin(phi1) * cos(phi2) * sin(lam2) - + cos(phi1) * sin(phi2) * sin(lam1)); + phip = atan(-cos(P->lamp - lam1) / tan(phi1)); + } + if (fabs(phip) > TOL) { /* oblique */ + P->cphip = cos(phip); + P->sphip = sin(phip); + P->fwd = o_forward; + P->inv = P->link->inv ? o_inverse : 0; + } else { /* transverse */ + P->fwd = t_forward; + P->inv = P->link->inv ? t_inverse : 0; + } +ENDENTRY(P) diff --git a/src/PJ_ocea.c b/src/PJ_ocea.c new file mode 100644 index 00000000..95fcda0d --- /dev/null +++ b/src/PJ_ocea.c @@ -0,0 +1,71 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_ocea.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double rok; \ + double rtk; \ + double sinphi; \ + double cosphi; \ + double singam; \ + double cosgam; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(ocea, "Oblique Cylindrical Equal Area") "\n\tCyl, Sph" + "lonc= alpha= or\n\tlat_1= lat_2= lon_1= lon_2="; +FORWARD(s_forward); /* spheroid */ + double t; + + xy.y = sin(lp.lam); +/* + xy.x = atan2((tan(lp.phi) * P->cosphi + P->sinphi * xy.y) , cos(lp.lam)); +*/ + t = cos(lp.lam); + xy.x = atan((tan(lp.phi) * P->cosphi + P->sinphi * xy.y) / t); + if (t < 0.) + xy.x += PI; + xy.x *= P->rtk; + xy.y = P->rok * (P->sinphi * sin(lp.phi) - P->cosphi * cos(lp.phi) * xy.y); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t, s; + + xy.y /= P->rok; + xy.x /= P->rtk; + t = sqrt(1. - xy.y * xy.y); + lp.phi = asin(xy.y * P->sinphi + t * P->cosphi * (s = sin(xy.x))); + lp.lam = atan2(t * P->sinphi * s - xy.y * P->cosphi, + t * cos(xy.x)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(ocea) + double phi_0, phi_1, phi_2, lam_1, lam_2, lonz, alpha; + + P->rok = P->a / P->k0; + P->rtk = P->a * P->k0; + if ( pj_param(P->params, "talpha").i) { + alpha = pj_param(P->params, "ralpha").f; + lonz = pj_param(P->params, "rlonc").f; + P->singam = atan(-cos(alpha)/(-sin(phi_0) * sin(alpha))) + lonz; + P->sinphi = asin(cos(phi_0) * sin(alpha)); + } else { + phi_1 = pj_param(P->params, "rlat_1").f; + phi_2 = pj_param(P->params, "rlat_2").f; + lam_1 = pj_param(P->params, "rlon_1").f; + lam_2 = pj_param(P->params, "rlon_2").f; + P->singam = atan2(cos(phi_1) * sin(phi_2) * cos(lam_1) - + sin(phi_1) * cos(phi_2) * cos(lam_2), + sin(phi_1) * cos(phi_2) * sin(lam_2) - + cos(phi_1) * sin(phi_2) * sin(lam_1) ); + P->sinphi = atan(-cos(P->singam - lam_1) / tan(phi_1)); + } + P->lam0 = P->singam + HALFPI; + P->cosphi = cos(P->sinphi); + P->sinphi = sin(P->sinphi); + P->cosgam = cos(P->singam); + P->singam = sin(P->singam); + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_oea.c b/src/PJ_oea.c new file mode 100644 index 00000000..dc890ef1 --- /dev/null +++ b/src/PJ_oea.c @@ -0,0 +1,61 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_oea.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double theta; \ + double m, n; \ + double two_r_m, two_r_n, rm, rn, hm, hn; \ + double cp0, sp0; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(oea, "Oblated Equal Area") "\n\tMisc Sph\n\tn= m= theta="; +FORWARD(s_forward); /* sphere */ + double Az, hz, M, N, cp, sp, cl, shz; + + cp = cos(lp.phi); + sp = sin(lp.phi); + cl = cos(lp.lam); + Az = aatan2(cp * sin(lp.lam), P->cp0 * sp - P->sp0 * cp * cl) + P->theta; + shz = sin(0.5 * aacos(P->sp0 * sp + P->cp0 * cp * cl)); + M = aasin(shz * sin(Az)); + N = aasin(shz * cos(Az) * cos(M) / cos(M * P->two_r_m)); + xy.y = P->n * sin(N * P->two_r_n); + xy.x = P->m * sin(M * P->two_r_m) * cos(N) / cos(N * P->two_r_n); + return (xy); +} +INVERSE(s_inverse); /* sphere */ + double N, M, xp, yp, z, Az, cz, sz, cAz; + + N = P->hn * aasin(xy.y * P->rn); + M = P->hm * aasin(xy.x * P->rm * cos(N * P->two_r_n) / cos(N)); + xp = 2. * sin(M); + yp = 2. * sin(N) * cos(M * P->two_r_m) / cos(M); + cAz = cos(Az = aatan2(xp, yp) - P->theta); + z = 2. * aasin(0.5 * hypot(xp, yp)); + sz = sin(z); + cz = cos(z); + lp.phi = aasin(P->sp0 * cz + P->cp0 * sz * cAz); + lp.lam = aatan2(sz * sin(Az), + P->cp0 * cz - P->sp0 * sz * cAz); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(oea) + if (((P->n = pj_param(P->params, "dn").f) <= 0.) || + ((P->m = pj_param(P->params, "dm").f) <= 0.)) + E_ERROR(-39) + else { + P->theta = pj_param(P->params, "rtheta").f; + P->sp0 = sin(P->phi0); + P->cp0 = cos(P->phi0); + P->rn = 1./ P->n; + P->rm = 1./ P->m; + P->two_r_n = 2. * P->rn; + P->two_r_m = 2. * P->rm; + P->hm = 0.5 * P->m; + P->hn = 0.5 * P->n; + P->fwd = s_forward; + P->inv = s_inverse; + P->es = 0.; + } +ENDENTRY(P) diff --git a/src/PJ_omerc.c b/src/PJ_omerc.c new file mode 100644 index 00000000..5494186b --- /dev/null +++ b/src/PJ_omerc.c @@ -0,0 +1,169 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_omerc.c 4.2 95/01/01 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double alpha, lamc, lam1, phi1, lam2, phi2, Gamma, al, bl, el, \ + singam, cosgam, sinrot, cosrot, u_0; \ + int ellips, rot; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(omerc, "Oblique Mercator") + "\n\tCyl, Sph&Ell\n\t no_rot rot_conv no_uoff and\n\t" +"alpha= lonc= or\n\t lon_1= lat_1= lon_2= lat_2="; +#define TOL 1.e-7 +#define EPS 1.e-10 +#define TSFN0(x) tan(.5 * (HALFPI - (x))) +FORWARD(e_forward); /* ellipsoid & spheroid */ + double con, q, s, ul, us, vl, vs; + + vl = sin(P->bl * lp.lam); + if (fabs(fabs(lp.phi) - HALFPI) <= EPS) { + ul = lp.phi < 0. ? -P->singam : P->singam; + us = P->al * lp.phi / P->bl; + } else { + q = P->el / (P->ellips ? pow(pj_tsfn(lp.phi, sin(lp.phi), P->e), P->bl) + : TSFN0(lp.phi)); + s = .5 * (q - 1. / q); + ul = 2. * (s * P->singam - vl * P->cosgam) / (q + 1. / q); + con = cos(P->bl * lp.lam); + if (fabs(con) >= TOL) { + us = P->al * atan((s * P->cosgam + vl * P->singam) / con) / P->bl; + if (con < 0.) + us += PI * P->al / P->bl; + } else + us = P->al * P->bl * lp.lam; + } + if (fabs(fabs(ul) - 1.) <= EPS) F_ERROR; + vs = .5 * P->al * log((1. - ul) / (1. + ul)) / P->bl; + us -= P->u_0; + if (! P->rot) { + xy.x = us; + xy.y = vs; + } else { + xy.x = vs * P->cosrot + us * P->sinrot; + xy.y = us * P->cosrot - vs * P->sinrot; + } + return (xy); +} +INVERSE(e_inverse); /* ellipsoid & spheroid */ + double q, s, ul, us, vl, vs; + + if (! P->rot) { + us = xy.x; + vs = xy.y; + } else { + vs = xy.x * P->cosrot - xy.y * P->sinrot; + us = xy.y * P->cosrot + xy.x * P->sinrot; + } + us += P->u_0; + q = exp(- P->bl * vs / P->al); + s = .5 * (q - 1. / q); + vl = sin(P->bl * us / P->al); + ul = 2. * (vl * P->cosgam + s * P->singam) / (q + 1. / q); + if (fabs(fabs(ul) - 1.) < EPS) { + lp.lam = 0.; + lp.phi = ul < 0. ? -HALFPI : HALFPI; + } else { + lp.phi = P->el / sqrt((1. + ul) / (1. - ul)); + if (P->ellips) { + if ((lp.phi = pj_phi2(pow(lp.phi, 1. / P->bl), P->e)) == HUGE_VAL) + I_ERROR; + } else + lp.phi = HALFPI - 2. * atan(lp.phi); + lp.lam = - atan2((s * P->cosgam - + vl * P->singam), cos(P->bl * us / P->al)) / P->bl; + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(omerc) + double con, com, cosph0, d, f, h, l, sinph0, p, j; + int azi; + + P->rot = pj_param(P->params, "bno_rot").i == 0; + if (azi = pj_param(P->params, "talpha").i) { + P->lamc = pj_param(P->params, "rlonc").f; + P->alpha = pj_param(P->params, "ralpha").f; + if ( fabs(P->alpha) <= TOL || + fabs(fabs(P->phi0) - HALFPI) <= TOL || + fabs(fabs(P->alpha) - HALFPI) <= TOL) + E_ERROR(-32); + } else { + P->lam1 = pj_param(P->params, "rlon_1").f; + P->phi1 = pj_param(P->params, "rlat_1").f; + P->lam2 = pj_param(P->params, "rlon_2").f; + P->phi2 = pj_param(P->params, "rlat_2").f; + if (fabs(P->phi1 - P->phi2) <= TOL || + (con = fabs(P->phi1)) <= TOL || + fabs(con - HALFPI) <= TOL || + fabs(fabs(P->phi0) - HALFPI) <= TOL || + fabs(fabs(P->phi2) - HALFPI) <= TOL) E_ERROR(-33); + } + com = (P->ellips = P->es > 0.) ? sqrt(P->one_es) : 1.; + if (fabs(P->phi0) > EPS) { + sinph0 = sin(P->phi0); + cosph0 = cos(P->phi0); + if (P->ellips) { + con = 1. - P->es * sinph0 * sinph0; + P->bl = cosph0 * cosph0; + P->bl = sqrt(1. + P->es * P->bl * P->bl / P->one_es); + P->al = P->bl * P->k0 * com / con; + d = P->bl * com / (cosph0 * sqrt(con)); + } else { + P->bl = 1.; + P->al = P->k0; + d = 1. / cosph0; + } + if ((f = d * d - 1.) <= 0.) + f = 0.; + else { + f = sqrt(f); + if (P->phi0 < 0.) + f = -f; + } + P->el = f += d; + if (P->ellips) P->el *= pow(pj_tsfn(P->phi0, sinph0, P->e), P->bl); + else P->el *= TSFN0(P->phi0); + } else { + P->bl = 1. / com; + P->al = P->k0; + P->el = d = f = 1.; + } + if (azi) { + P->Gamma = asin(sin(P->alpha) / d); + P->lam0 = P->lamc - asin((.5 * (f - 1. / f)) * + tan(P->Gamma)) / P->bl; + } else { + if (P->ellips) { + h = pow(pj_tsfn(P->phi1, sin(P->phi1), P->e), P->bl); + l = pow(pj_tsfn(P->phi2, sin(P->phi2), P->e), P->bl); + } else { + h = TSFN0(P->phi1); + l = TSFN0(P->phi2); + } + f = P->el / h; + p = (l - h) / (l + h); + j = P->el * P->el; + j = (j - l * h) / (j + l * h); + if ((con = P->lam1 - P->lam2) < -PI) + P->lam2 -= TWOPI; + else if (con > PI) + P->lam2 += TWOPI; + P->lam0 = adjlon(.5 * (P->lam1 + P->lam2) - atan( + j * tan(.5 * P->bl * (P->lam1 - P->lam2)) / p) / P->bl); + P->Gamma = atan(2. * sin(P->bl * adjlon(P->lam1 - P->lam0)) / + (f - 1. / f)); + P->alpha = asin(d * sin(P->Gamma)); + } + P->singam = sin(P->Gamma); + P->cosgam = cos(P->Gamma); + f = pj_param(P->params, "brot_conv").i ? P->Gamma : P->alpha; + P->sinrot = sin(f); + P->cosrot = cos(f); + P->u_0 = pj_param(P->params, "bno_uoff").i ? 0. : + fabs(P->al * atan(sqrt(d * d - 1.) / P->cosrot) / P->bl); + if (P->phi0 < 0.) + P->u_0 = - P->u_0; + P->inv = e_inverse; + P->fwd = e_forward; +ENDENTRY(P) diff --git a/src/PJ_ortho.c b/src/PJ_ortho.c new file mode 100644 index 00000000..98abf731 --- /dev/null +++ b/src/PJ_ortho.c @@ -0,0 +1,92 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_ortho.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double sinph0; \ + double cosph0; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(ortho, "Orthographic") "\n\tAzi, Sph."; +#define EPS10 1.e-10 +#define N_POLE 0 +#define S_POLE 1 +#define EQUIT 2 +#define OBLIQ 3 +FORWARD(s_forward); /* spheroid */ + double coslam, cosphi, sinphi; + + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + switch (P->mode) { + case EQUIT: + if (cosphi * coslam < - EPS10) F_ERROR; + xy.y = sin(lp.phi); + break; + case OBLIQ: + if (P->sinph0 * (sinphi = sin(lp.phi)) + + P->cosph0 * cosphi * coslam < - EPS10) F_ERROR; + xy.y = P->cosph0 * sinphi - P->sinph0 * cosphi * coslam; + break; + case N_POLE: + coslam = - coslam; + case S_POLE: + if (fabs(lp.phi - P->phi0) - EPS10 > HALFPI) F_ERROR; + xy.y = cosphi * coslam; + break; + } + xy.x = cosphi * sin(lp.lam); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double rh, cosc, sinc; + + if ((sinc = (rh = hypot(xy.x, xy.y))) > 1.) { + if ((sinc - 1.) > EPS10) I_ERROR; + sinc = 1.; + } + cosc = sqrt(1. - sinc * sinc); /* in this range OK */ + if (fabs(rh) <= EPS10) + lp.phi = P->phi0; + else switch (P->mode) { + case N_POLE: + xy.y = -xy.y; + lp.phi = acos(sinc); + break; + case S_POLE: + lp.phi = - acos(sinc); + break; + case EQUIT: + lp.phi = xy.y * sinc / rh; + xy.x *= sinc; + xy.y = cosc * rh; + goto sinchk; + case OBLIQ: + lp.phi = cosc * P->sinph0 + xy.y * sinc * P->cosph0 / rh; + xy.y = (cosc - P->sinph0 * lp.phi) * rh; + xy.x *= sinc * P->cosph0; +sinchk: + if (fabs(lp.phi) >= 1.) + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + else + lp.phi = asin(lp.phi); + break; + } + lp.lam = (xy.y == 0. && (P->mode == OBLIQ || P->mode == EQUIT)) ? + (xy.x == 0. ? 0. : xy.x < 0. ? -HALFPI : HALFPI) : atan2(xy.x, xy.y); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(ortho) + if (fabs(fabs(P->phi0) - HALFPI) <= EPS10) + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + else if (fabs(P->phi0) > EPS10) { + P->mode = OBLIQ; + P->sinph0 = sin(P->phi0); + P->cosph0 = cos(P->phi0); + } else + P->mode = EQUIT; + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_poly.c b/src/PJ_poly.c new file mode 100644 index 00000000..04d8cd96 --- /dev/null +++ b/src/PJ_poly.c @@ -0,0 +1,102 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_poly.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double ml0; \ + double *en; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(poly, "Polyconic (American)") + "\n\tConic, Sph&Ell"; +#define TOL 1e-10 +#define CONV 1e-10 +#define N_ITER 10 +#define I_ITER 20 +#define ITOL 1.e-12 +FORWARD(e_forward); /* ellipsoid */ + double ms, sp, cp; + + if (fabs(lp.phi) <= TOL) { xy.x = lp.lam; xy.y = -P->ml0; } + else { + sp = sin(lp.phi); + ms = fabs(cp = cos(lp.phi)) > TOL ? pj_msfn(sp, cp, P->es) / sp : 0.; + xy.x = ms * sin(lp.lam *= sp); + xy.y = (pj_mlfn(lp.phi, sp, cp, P->en) - P->ml0) + ms * (1. - cos(lp.lam)); + } + return (xy); +} +FORWARD(s_forward); /* spheroid */ + double cot, E; + + if (fabs(lp.phi) <= TOL) { xy.x = lp.lam; xy.y = P->ml0; } + else { + cot = 1. / tan(lp.phi); + xy.x = sin(E = lp.lam * sin(lp.phi)) * cot; + xy.y = lp.phi - P->phi0 + cot * (1. - cos(E)); + } + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + xy.y += P->ml0; + if (fabs(xy.y) <= TOL) { lp.lam = xy.x; lp.phi = 0.; } + else { + double r, c, sp, cp, s2ph, ml, mlb, mlp, dPhi; + int i; + + r = xy.y * xy.y + xy.x * xy.x; + for (lp.phi = xy.y, i = I_ITER; i ; --i) { + sp = sin(lp.phi); + s2ph = sp * ( cp = cos(lp.phi)); + if (fabs(cp) < ITOL) + I_ERROR; + c = sp * (mlp = sqrt(1. - P->es * sp * sp)) / cp; + ml = pj_mlfn(lp.phi, sp, cp, P->en); + mlb = ml * ml + r; + mlp = P->one_es / (mlp * mlp * mlp); + lp.phi += ( dPhi = + ( ml + ml + c * mlb - 2. * xy.y * (c * ml + 1.) ) / ( + P->es * s2ph * (mlb - 2. * xy.y * ml) / c + + 2.* (xy.y - ml) * (c * mlp - 1. / s2ph) - mlp - mlp )); + if (fabs(dPhi) <= ITOL) + break; + } + if (!i) + I_ERROR; + c = sin(lp.phi); + lp.lam = asin(xy.x * tan(lp.phi) * sqrt(1. - P->es * c * c)) / sin(lp.phi); + } + return (lp); +} +INVERSE(s_inverse); /* spheroid */ + double B, dphi, tp; + int i; + + if (fabs(xy.y = P->phi0 + xy.y) <= TOL) { lp.lam = xy.x; lp.phi = 0.; } + else { + lp.phi = xy.y; + B = xy.x * xy.x + xy.y * xy.y; + i = N_ITER; + do { + tp = tan(lp.phi); + lp.phi -= (dphi = (xy.y * (lp.phi * tp + 1.) - lp.phi - + .5 * ( lp.phi * lp.phi + B) * tp) / + ((lp.phi - xy.y) / tp - 1.)); + } while (fabs(dphi) > CONV && --i); + if (! i) I_ERROR; + lp.lam = asin(xy.x * tan(lp.phi)) / sin(lp.phi); + } + return (lp); +} +FREEUP; if (P) { if (P->en) pj_dalloc(P->en); pj_dalloc(P); } } +ENTRY1(poly, en) + if (P->es) { + if (!(P->en = pj_enfn(P->es))) E_ERROR_0; + P->ml0 = pj_mlfn(P->phi0, sin(P->phi0), cos(P->phi0), P->en); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + P->ml0 = -P->phi0; + P->inv = s_inverse; + P->fwd = s_forward; + } +ENDENTRY(P) diff --git a/src/PJ_putp2.c b/src/PJ_putp2.c new file mode 100644 index 00000000..89ec6720 --- /dev/null +++ b/src/PJ_putp2.c @@ -0,0 +1,43 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_putp2.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(putp2, "Putnins P2") "\n\tPCyl., Sph."; +#define C_x 1.89490 +#define C_y 1.71848 +#define C_p 0.6141848493043784 +#define EPS 1e-10 +#define NITER 10 +#define PI_DIV_3 1.0471975511965977 +FORWARD(s_forward); /* spheroid */ + double p, c, s, V; + int i; + + p = C_p * sin(lp.phi); + s = lp.phi * lp.phi; + lp.phi *= 0.615709 + s * ( 0.00909953 + s * 0.0046292 ); + for (i = NITER; i ; --i) { + c = cos(lp.phi); + s = sin(lp.phi); + lp.phi -= V = (lp.phi + s * (c - 1.) - p) / + (1. + c * (c - 1.) - s * s); + if (fabs(V) < EPS) + break; + } + if (!i) + lp.phi = lp.phi < 0 ? - PI_DIV_3 : PI_DIV_3; + xy.x = C_x * lp.lam * (cos(lp.phi) - 0.5); + xy.y = C_y * sin(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double c; + + lp.phi = aasin(xy.y / C_y); + lp.lam = xy.x / (C_x * ((c = cos(lp.phi)) - 0.5)); + lp.phi = aasin((lp.phi + sin(lp.phi) * (c - 1.)) / C_p); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(putp2) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_putp3.c b/src/PJ_putp3.c new file mode 100644 index 00000000..c228423c --- /dev/null +++ b/src/PJ_putp3.c @@ -0,0 +1,29 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_putp3.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double A; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(putp3, "Putnins P3") "\n\tPCyl., Sph."; +PROJ_HEAD(putp3p, "Putnins P3'") "\n\tPCyl., no inv., Sph."; +#define C 0.79788456 +#define RPISQ 0.1013211836 +FORWARD(s_forward); /* spheroid */ + xy.x = C * lp.lam * (1. - P->A * lp.phi * lp.phi); + xy.y = C * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / C; + lp.lam = xy.x / (C * (1. - P->A * lp.phi * lp.phi)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; + return P; +} +ENTRY0(putp3) P->A = 4. * RPISQ; ENDENTRY(setup(P)) +ENTRY0(putp3p) P->A = 2. * RPISQ; ENDENTRY(setup(P)) diff --git a/src/PJ_putp4p.c b/src/PJ_putp4p.c new file mode 100644 index 00000000..1d07350f --- /dev/null +++ b/src/PJ_putp4p.c @@ -0,0 +1,32 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_putp4p.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x, C_y; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(putp4p, "Putnins P4'") "\n\tPCyl., Sph."; +PROJ_HEAD(weren, "Werenskiold I") "\n\tPCyl., Sph."; +FORWARD(s_forward); /* spheroid */ + lp.phi = aasin(0.883883476 * sin(lp.phi)); + xy.x = P->C_x * lp.lam * cos(lp.phi); + xy.x /= cos(lp.phi *= 0.333333333333333); + xy.y = P->C_y * sin(lp.phi); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = aasin(xy.y / P->C_y); + lp.lam = xy.x * cos(lp.phi) / P->C_x; + lp.phi *= 3.; + lp.lam /= cos(lp.phi); + lp.phi = aasin(1.13137085 * sin(lp.phi)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; + return P; +} +ENTRY0(putp4p) P->C_x = 0.874038744; P->C_y = 3.883251825; ENDENTRY(setup(P)) +ENTRY0(weren) P->C_x = 1.; P->C_y = 4.442882938; ENDENTRY(setup(P)) diff --git a/src/PJ_putp5.c b/src/PJ_putp5.c new file mode 100644 index 00000000..7e20012a --- /dev/null +++ b/src/PJ_putp5.c @@ -0,0 +1,29 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_putp5.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double A, B; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(putp5, "Putnins P5") "\n\tPCyl., Sph."; +PROJ_HEAD(putp5p, "Putnins P5'") "\n\tPCyl., Sph."; +#define C 1.01346 +#define D 1.2158542 +FORWARD(s_forward); /* spheroid */ + xy.x = C * lp.lam * (P->A - P->B * sqrt(1. + D * lp.phi * lp.phi)); + xy.y = C * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / C; + lp.lam = xy.x / (C * (P->A - P->B * sqrt(1. + D * lp.phi * lp.phi))); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; + return P; +} +ENTRY0(putp5) P->A = 2.; P->B = 1.; ENDENTRY(setup(P)) +ENTRY0(putp5p) P->A = 1.5; P->B = 0.5; ENDENTRY(setup(P)) diff --git a/src/PJ_putp6.c b/src/PJ_putp6.c new file mode 100644 index 00000000..ae3e68b4 --- /dev/null +++ b/src/PJ_putp6.c @@ -0,0 +1,62 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_putp6.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x, C_y, A, B, D; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(putp6, "Putnins P6") "\n\tPCyl., Sph."; +PROJ_HEAD(putp6p, "Putnins P6'") "\n\tPCyl., Sph."; +#define EPS 1e-10 +#define NITER 10 +#define CON_POLE 1.732050807568877 +FORWARD(s_forward); /* spheroid */ + double p, r, V; + int i; + + p = P->B * sin(lp.phi); + lp.phi *= 1.10265779; + for (i = NITER; i ; --i) { + r = sqrt(1. + lp.phi * lp.phi); + lp.phi -= V = ( (P->A - r) * lp.phi - log(lp.phi + r) - p ) / + (P->A - 2. * r); + if (fabs(V) < EPS) + break; + } + if (!i) + lp.phi = p < 0. ? -CON_POLE : CON_POLE; + xy.x = P->C_x * lp.lam * (P->D - sqrt(1. + lp.phi * lp.phi)); + xy.y = P->C_y * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double r; + + lp.phi = xy.y / P->C_y; + r = sqrt(1. + lp.phi * lp.phi); + lp.lam = xy.x / (P->C_x * (P->D - r)); + lp.phi = aasin( ( (P->A - r) * lp.phi - log(lp.phi + r) ) / P->B); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->es = 0.; + P->inv = s_inverse; + P->fwd = s_forward; + return P; +} +ENTRY0(putp6) + P->C_x = 1.01346; + P->C_y = 0.91910; + P->A = 4.; + P->B = 2.1471437182129378784; + P->D = 2.; +ENDENTRY(setup(P)) +ENTRY0(putp6p) + P->C_x = 0.44329; + P->C_y = 0.80404; + P->A = 6.; + P->B = 5.61125; + P->D = 3.; +ENDENTRY(setup(P)) diff --git a/src/PJ_robin.c b/src/PJ_robin.c new file mode 100644 index 00000000..526796ff --- /dev/null +++ b/src/PJ_robin.c @@ -0,0 +1,108 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_robin.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(robin, "Robinson") "\n\tPCyl., Sph."; +#define V(C,z) (C.c0 + z * (C.c1 + z * (C.c2 + z * C.c3))) +#define DV(C,z) (C.c1 + z * (C.c2 + C.c2 + z * 3. * C.c3)) +/* note: following terms based upon 5 deg. intervals in degrees. */ +static struct COEFS { + float c0, c1, c2, c3; +} X[] = { +1, -5.67239e-12, -7.15511e-05, 3.11028e-06, +0.9986, -0.000482241, -2.4897e-05, -1.33094e-06, +0.9954, -0.000831031, -4.4861e-05, -9.86588e-07, +0.99, -0.00135363, -5.96598e-05, 3.67749e-06, +0.9822, -0.00167442, -4.4975e-06, -5.72394e-06, +0.973, -0.00214869, -9.03565e-05, 1.88767e-08, +0.96, -0.00305084, -9.00732e-05, 1.64869e-06, +0.9427, -0.00382792, -6.53428e-05, -2.61493e-06, +0.9216, -0.00467747, -0.000104566, 4.8122e-06, +0.8962, -0.00536222, -3.23834e-05, -5.43445e-06, +0.8679, -0.00609364, -0.0001139, 3.32521e-06, +0.835, -0.00698325, -6.40219e-05, 9.34582e-07, +0.7986, -0.00755337, -5.00038e-05, 9.35532e-07, +0.7597, -0.00798325, -3.59716e-05, -2.27604e-06, +0.7186, -0.00851366, -7.0112e-05, -8.63072e-06, +0.6732, -0.00986209, -0.000199572, 1.91978e-05, +0.6213, -0.010418, 8.83948e-05, 6.24031e-06, +0.5722, -0.00906601, 0.000181999, 6.24033e-06, +0.5322, 0.,0.,0. }, +Y[] = { +0, 0.0124, 3.72529e-10, 1.15484e-09, +0.062, 0.0124001, 1.76951e-08, -5.92321e-09, +0.124, 0.0123998, -7.09668e-08, 2.25753e-08, +0.186, 0.0124008, 2.66917e-07, -8.44523e-08, +0.248, 0.0123971, -9.99682e-07, 3.15569e-07, +0.31, 0.0124108, 3.73349e-06, -1.1779e-06, +0.372, 0.0123598, -1.3935e-05, 4.39588e-06, +0.434, 0.0125501, 5.20034e-05, -1.00051e-05, +0.4968, 0.0123198, -9.80735e-05, 9.22397e-06, +0.5571, 0.0120308, 4.02857e-05, -5.2901e-06, +0.6176, 0.0120369, -3.90662e-05, 7.36117e-07, +0.6769, 0.0117015, -2.80246e-05, -8.54283e-07, +0.7346, 0.0113572, -4.08389e-05, -5.18524e-07, +0.7903, 0.0109099, -4.86169e-05, -1.0718e-06, +0.8435, 0.0103433, -6.46934e-05, 5.36384e-09, +0.8936, 0.00969679, -6.46129e-05, -8.54894e-06, +0.9394, 0.00840949, -0.000192847, -4.21023e-06, +0.9761, 0.00616525, -0.000256001, -4.21021e-06, +1., 0.,0.,0 }; +#define FXC 0.8487 +#define FYC 1.3523 +#define C1 11.45915590261646417544 +#define RC1 0.08726646259971647884 +#define NODES 18 +#define ONEEPS 1.000001 +#define EPS 1e-8 +FORWARD(s_forward); /* spheroid */ + int i; + double dphi; + + i = floor((dphi = fabs(lp.phi)) * C1); + if (i >= NODES) i = NODES - 1; + dphi = RAD_TO_DEG * (dphi - RC1 * i); + xy.x = V(X[i], dphi) * FXC * lp.lam; + xy.y = V(Y[i], dphi) * FYC; + if (lp.phi < 0.) xy.y = -xy.y; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + int i; + double t, t1; + struct COEFS T; + + lp.lam = xy.x / FXC; + lp.phi = fabs(xy.y / FYC); + if (lp.phi >= 1.) { /* simple pathologic cases */ + if (lp.phi > ONEEPS) I_ERROR + else { + lp.phi = xy.y < 0. ? -HALFPI : HALFPI; + lp.lam /= X[NODES].c0; + } + } else { /* general problem */ + /* in Y space, reduce to table interval */ + for (i = floor(lp.phi * NODES);;) { + if (Y[i].c0 > lp.phi) --i; + else if (Y[i+1].c0 <= lp.phi) ++i; + else break; + } + T = Y[i]; + /* first guess, linear interp */ + t = 5. * (lp.phi - T.c0)/(Y[i+1].c0 - T.c0); + /* make into root */ + T.c0 -= lp.phi; + for (;;) { /* Newton-Raphson reduction */ + t -= t1 = V(T,t) / DV(T,t); + if (fabs(t1) < EPS) + break; + } + lp.phi = (5 * i + t) * DEG_TO_RAD; + if (xy.y < 0.) lp.phi = -lp.phi; + lp.lam /= V(X[i], t); + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(robin) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_rpoly.c b/src/PJ_rpoly.c new file mode 100644 index 00000000..7873b8c0 --- /dev/null +++ b/src/PJ_rpoly.c @@ -0,0 +1,38 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_rpoly.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phi1; \ + double fxa; \ + double fxb; \ + int mode; +#define EPS 1e-9 +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(rpoly, "Rectangular Polyconic") + "\n\tConic, Sph., no inv.\n\tlat_ts="; +FORWARD(s_forward); /* spheroid */ + double fa; + + if (P->mode) + fa = tan(lp.lam * P->fxb) * P->fxa; + else + fa = 0.5 * lp.lam; + if (fabs(lp.phi) < EPS) { + xy.x = fa + fa; + xy.y = - P->phi0; + } else { + xy.y = 1. / tan(lp.phi); + xy.x = sin(fa = 2. * atan(fa * sin(lp.phi))) * xy.y; + xy.y = lp.phi - P->phi0 + (1. - cos(fa)) * xy.y; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(rpoly) + if ((P->mode = (P->phi1 = fabs(pj_param(P->params, "rlat_ts").f)) > EPS)) { + P->fxb = 0.5 * sin(P->phi1); + P->fxa = 0.5 / P->fxb; + } + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_sconics.c b/src/PJ_sconics.c new file mode 100644 index 00000000..567e4f60 --- /dev/null +++ b/src/PJ_sconics.c @@ -0,0 +1,157 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_sconics.c 4.1 94/05/22 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double n; \ + double rho_c; \ + double rho_0; \ + double sig; \ + double c1, c2; \ + int type; +#define PJ_LIB__ +#include <projects.h> +#define EULER 0 +#define MURD1 1 +#define MURD2 2 +#define MURD3 3 +#define PCONIC 4 +#define TISSOT 5 +#define VITK1 6 +#define EPS10 1.e-10 +#define EPS 1e-10 +#define LINE2 "\n\tConic, Sph\n\tlat_1= and lat_2=" +PROJ_HEAD(tissot, "Tissot") + LINE2; +PROJ_HEAD(murd1, "Murdoch I") + LINE2; +PROJ_HEAD(murd2, "Murdoch II") + LINE2; +PROJ_HEAD(murd3, "Murdoch III") + LINE2; +PROJ_HEAD(euler, "Euler") + LINE2; +PROJ_HEAD(pconic, "Perspective Conic") + LINE2; +PROJ_HEAD(vitk1, "Vitkovsky I") + LINE2; +/* get common factors for simple conics */ + static int +phi12(PJ *P, double *del) { + double p1, p2, d, s; + int err = 0; + + if (!pj_param(P->params, "tlat_1").i || + !pj_param(P->params, "tlat_2").i) { + err = -41; + } else { + p1 = pj_param(P->params, "rlat_1").f; + p2 = pj_param(P->params, "rlat_2").f; + *del = 0.5 * (p2 - p1); + P->sig = 0.5 * (p2 + p1); + err = (fabs(*del) < EPS || fabs(P->sig) < EPS) ? -42 : 0; + *del = *del; + } + return err; +} +FORWARD(s_forward); /* spheroid */ + double rho; + + switch (P->type) { + case MURD2: + rho = P->rho_c + tan(P->sig - lp.phi); + break; + case PCONIC: + rho = P->c2 * (P->c1 - tan(lp.phi)); + break; + default: + rho = P->rho_c - lp.phi; + break; + } + xy.x = rho * sin( lp.lam *= P->n ); + xy.y = P->rho_0 - rho * cos(lp.lam); + return (xy); +} +INVERSE(s_inverse); /* ellipsoid & spheroid */ + double rho; + + rho = hypot(xy.x, xy.y = P->rho_0 - xy.y); + if (P->n < 0.) { + rho = - rho; + xy.x = - xy.x; + xy.y = - xy.y; + } + lp.lam = atan2(xy.x, xy.y) / P->n; + switch (P->type) { + case PCONIC: + lp.phi = atan(P->c1 - rho / P->c2) + P->sig; + break; + case MURD2: + lp.phi = P->sig - atan(rho - P->rho_c); + break; + default: + lp.phi = P->rho_c - rho; + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + double del, cs, dummy; + int i; + + if (i = phi12(P, &del)) + E_ERROR(i); + switch (P->type) { + case TISSOT: + P->n = sin(P->sig); + cs = cos(del); + P->rho_c = P->n / cs + cs / P->n; + P->rho_0 = sqrt((P->rho_c - 2 * sin(P->phi0))/P->n); + break; + case MURD1: + P->rho_c = sin(del)/(del * tan(P->sig)) + P->sig; + P->rho_0 = P->rho_c - P->phi0; + P->n = sin(P->sig); + break; + case MURD2: + P->rho_c = (cs = sqrt(cos(del))) / tan(P->sig); + P->rho_0 = P->rho_c + tan(P->sig - P->phi0); + P->n = sin(P->sig) * cs; + break; + case MURD3: + P->rho_c = del / (tan(P->sig) * tan(del)) + P->sig; + P->rho_0 = P->rho_c - P->phi0; + P->n = sin(P->sig) * sin(del) * tan(del) / (del * del); + break; + case EULER: + P->n = sin(P->sig) * sin(del) / del; + del *= 0.5; + P->rho_c = del / (tan(del) * tan(P->sig)) + P->sig; + P->rho_0 = P->rho_c - P->phi0; + break; + case PCONIC: + P->n = sin(P->sig); + P->c2 = cos(del); + P->c1 = 1./tan(P->sig); + if (fabs(del = P->phi0 - P->sig) - EPS10 >= HALFPI) + E_ERROR(-43); + P->rho_0 = P->c2 * (P->c1 - tan(del)); + break; + case VITK1: + P->n = (cs = tan(del)) * sin(P->sig) / del; + P->rho_c = del / (cs * tan(P->sig)) + P->sig; + P->rho_0 = P->rho_c - P->phi0; + break; + } + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0; + return (P); +} +ENTRY0(euler) P->type = EULER; ENDENTRY(setup(P)) +ENTRY0(tissot) P->type = TISSOT; ENDENTRY(setup(P)) +ENTRY0(murd1) P->type = MURD1; ENDENTRY(setup(P)) +ENTRY0(murd2) P->type = MURD2; ENDENTRY(setup(P)) +ENTRY0(murd3) P->type = MURD3; ENDENTRY(setup(P)) +ENTRY0(pconic) P->type = PCONIC; ENDENTRY(setup(P)) +ENTRY0(vitk1) P->type = VITK1; ENDENTRY(setup(P)) diff --git a/src/PJ_somerc.c b/src/PJ_somerc.c new file mode 100644 index 00000000..4be9f085 --- /dev/null +++ b/src/PJ_somerc.c @@ -0,0 +1,69 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_somerc.c 4.1 95/08/09 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double K, c, hlf_e, kR, cosp0, sinp0; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(somerc, "Swiss. Obl. Mercator") "\n\tCyl, Ell\n\tFor CH1903"; +#define EPS 1.e-10 +#define NITER 6 +FORWARD(e_forward); + double phip, lamp, phipp, lampp, sp, cp; + + sp = P->e * sin(lp.phi); + phip = 2.* atan( exp( P->c * ( + log(tan(FORTPI + 0.5 * lp.phi)) - P->hlf_e * log((1. + sp)/(1. - sp))) + + P->K)) - HALFPI; + lamp = P->c * lp.lam; + cp = cos(phip); + phipp = aasin(P->cosp0 * sin(phip) - P->sinp0 * cp * cos(lamp)); + lampp = aasin(cp * sin(lamp) / cos(phipp)); + xy.x = P->kR * lampp; + xy.y = P->kR * log(tan(FORTPI + 0.5 * phipp)); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid & spheroid */ + double phip, lamp, phipp, lampp, cp, esp, con, delp; + int i; + + phipp = 2. * (atan(exp(xy.y / P->kR)) - FORTPI); + lampp = xy.x / P->kR; + cp = cos(phipp); + phip = aasin(P->cosp0 * sin(phipp) + P->sinp0 * cp * cos(lampp)); + lamp = aasin(cp * sin(lampp) / cos(phip)); + con = (P->K - log(tan(FORTPI + 0.5 * phip)))/P->c; + for (i = NITER; i ; --i) { + esp = P->e * sin(phip); + delp = (con + log(tan(FORTPI + 0.5 * phip)) - P->hlf_e * + log((1. + esp)/(1. - esp)) ) * + (1. - esp * esp) * cos(phip) * P->rone_es; + phip -= delp; + if (fabs(delp) < EPS) + break; + } + if (i) { + lp.phi = phip; + lp.lam = lamp / P->c; + } else + I_ERROR + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(somerc) + double cp, phip0, sp; + + P->hlf_e = 0.5 * P->e; + cp = cos(P->phi0); + cp *= cp; + P->c = sqrt(1 + P->es * cp * cp * P->rone_es); + sp = sin(P->phi0); + P->cosp0 = cos( phip0 = aasin(P->sinp0 = sp / P->c) ); + sp *= P->e; + P->K = log(tan(FORTPI + 0.5 * phip0)) - P->c * ( + log(tan(FORTPI + 0.5 * P->phi0)) - P->hlf_e * + log((1. + sp) / (1. - sp))); + P->kR = P->k0 * sqrt(P->one_es) / (1. - sp * sp); + P->inv = e_inverse; + P->fwd = e_forward; +ENDENTRY(P) diff --git a/src/PJ_stere.c b/src/PJ_stere.c new file mode 100644 index 00000000..5c130420 --- /dev/null +++ b/src/PJ_stere.c @@ -0,0 +1,244 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_stere.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double phits; \ + double sinX1; \ + double cosX1; \ + double akm1; \ + int mode; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(stere, "Stereographic") "\n\tAzi, Sph&Ell\n\tlat_ts="; +PROJ_HEAD(ups, "Universal Polar Stereographic") "\n\tAzi, Sph&Ell\n\tsouth"; +#define sinph0 P->sinX1 +#define cosph0 P->cosX1 +#define EPS10 1.e-10 +#define TOL 1.e-8 +#define NITER 8 +#define CONV 1.e-10 +#define S_POLE 0 +#define N_POLE 1 +#define OBLIQ 2 +#define EQUIT 3 + static double +ssfn_(double phit, double sinphi, double eccen) { + sinphi *= eccen; + return (tan (.5 * (HALFPI + phit)) * + pow((1. - sinphi) / (1. + sinphi), .5 * eccen)); +} +FORWARD(e_forward); /* ellipsoid */ + double coslam, sinlam, sinX, cosX, X, A, sinphi; + + coslam = cos(lp.lam); + sinlam = sin(lp.lam); + sinphi = sin(lp.phi); + if (P->mode == OBLIQ || P->mode == EQUIT) { + sinX = sin(X = 2. * atan(ssfn_(lp.phi, sinphi, P->e)) - HALFPI); + cosX = cos(X); + } + switch (P->mode) { + case OBLIQ: + A = P->akm1 / (P->cosX1 * (1. + P->sinX1 * sinX + + P->cosX1 * cosX * coslam)); + xy.y = A * (P->cosX1 * sinX - P->sinX1 * cosX * coslam); + goto xmul; + case EQUIT: + A = 2. * P->akm1 / (1. + cosX * coslam); + xy.y = A * sinX; +xmul: + xy.x = A * cosX; + break; + case S_POLE: + lp.phi = -lp.phi; + coslam = - coslam; + sinphi = -sinphi; + case N_POLE: + xy.x = P->akm1 * pj_tsfn(lp.phi, sinphi, P->e); + xy.y = - xy.x * coslam; + break; + } + xy.x = xy.x * sinlam; + return (xy); +} +FORWARD(s_forward); /* spheroid */ + double sinphi, cosphi, coslam, sinlam; + + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + coslam = cos(lp.lam); + sinlam = sin(lp.lam); + switch (P->mode) { + case EQUIT: + xy.y = 1. + cosphi * coslam; + goto oblcon; + case OBLIQ: + xy.y = 1. + sinph0 * sinphi + cosph0 * cosphi * coslam; +oblcon: + if (xy.y <= EPS10) F_ERROR; + xy.x = (xy.y = P->akm1 / xy.y) * cosphi * sinlam; + xy.y *= (P->mode == EQUIT) ? sinphi : + cosph0 * sinphi - sinph0 * cosphi * coslam; + break; + case N_POLE: + coslam = - coslam; + lp.phi = - lp.phi; + case S_POLE: + if (fabs(lp.phi - HALFPI) < TOL) F_ERROR; + xy.x = sinlam * ( xy.y = P->akm1 * tan(FORTPI + .5 * lp.phi) ); + xy.y *= coslam; + break; + } + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + double cosphi, sinphi, tp, phi_l, rho, halfe, halfpi; + int i; + + rho = hypot(xy.x, xy.y); + switch (P->mode) { + case OBLIQ: + case EQUIT: + cosphi = cos( tp = 2. * atan2(rho * P->cosX1 , P->akm1) ); + sinphi = sin(tp); + if( rho == 0.0 ) + phi_l = asin(cosphi * P->sinX1); + else + phi_l = asin(cosphi * P->sinX1 + (xy.y * sinphi * P->cosX1 / rho)); + + tp = tan(.5 * (HALFPI + phi_l)); + xy.x *= sinphi; + xy.y = rho * P->cosX1 * cosphi - xy.y * P->sinX1* sinphi; + halfpi = HALFPI; + halfe = .5 * P->e; + break; + case N_POLE: + xy.y = -xy.y; + case S_POLE: + phi_l = HALFPI - 2. * atan(tp = - rho / P->akm1); + halfpi = -HALFPI; + halfe = -.5 * P->e; + break; + } + for (i = NITER; i--; phi_l = lp.phi) { + sinphi = P->e * sin(phi_l); + lp.phi = 2. * atan(tp * pow((1.+sinphi)/(1.-sinphi), + halfe)) - halfpi; + if (fabs(phi_l - lp.phi) < CONV) { + if (P->mode == S_POLE) + lp.phi = -lp.phi; + lp.lam = (xy.x == 0. && xy.y == 0.) ? 0. : atan2(xy.x, xy.y); + return (lp); + } + } + I_ERROR; +} +INVERSE(s_inverse); /* spheroid */ + double c, rh, sinc, cosc; + + sinc = sin(c = 2. * atan((rh = hypot(xy.x, xy.y)) / P->akm1)); + cosc = cos(c); + lp.lam = 0.; + switch (P->mode) { + case EQUIT: + if (fabs(rh) <= EPS10) + lp.phi = 0.; + else + lp.phi = asin(xy.y * sinc / rh); + if (cosc != 0. || xy.x != 0.) + lp.lam = atan2(xy.x * sinc, cosc * rh); + break; + case OBLIQ: + if (fabs(rh) <= EPS10) + lp.phi = P->phi0; + else + lp.phi = asin(cosc * sinph0 + xy.y * sinc * cosph0 / rh); + if ((c = cosc - sinph0 * sin(lp.phi)) != 0. || xy.x != 0.) + lp.lam = atan2(xy.x * sinc * cosph0, c * rh); + break; + case N_POLE: + xy.y = -xy.y; + case S_POLE: + if (fabs(rh) <= EPS10) + lp.phi = P->phi0; + else + lp.phi = asin(P->mode == S_POLE ? - cosc : cosc); + lp.lam = (xy.x == 0. && xy.y == 0.) ? 0. : atan2(xy.x, xy.y); + break; + } + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { /* general initialization */ + double t; + + if (fabs((t = fabs(P->phi0)) - HALFPI) < EPS10) + P->mode = P->phi0 < 0. ? S_POLE : N_POLE; + else + P->mode = t > EPS10 ? OBLIQ : EQUIT; + P->phits = fabs(P->phits); + if (P->es) { + double X; + + switch (P->mode) { + case N_POLE: + case S_POLE: + if (fabs(P->phits - HALFPI) < EPS10) + P->akm1 = 2. * P->k0 / + sqrt(pow(1+P->e,1+P->e)*pow(1-P->e,1-P->e)); + else { + P->akm1 = cos(P->phits) / + pj_tsfn(P->phits, t = sin(P->phits), P->e); + t *= P->e; + P->akm1 /= sqrt(1. - t * t); + } + break; + case EQUIT: + P->akm1 = 2. * P->k0; + break; + case OBLIQ: + t = sin(P->phi0); + X = 2. * atan(ssfn_(P->phi0, t, P->e)) - HALFPI; + t *= P->e; + P->akm1 = 2. * P->k0 * cos(P->phi0) / sqrt(1. - t * t); + P->sinX1 = sin(X); + P->cosX1 = cos(X); + break; + } + P->inv = e_inverse; + P->fwd = e_forward; + } else { + switch (P->mode) { + case OBLIQ: + sinph0 = sin(P->phi0); + cosph0 = cos(P->phi0); + case EQUIT: + P->akm1 = 2. * P->k0; + break; + case S_POLE: + case N_POLE: + P->akm1 = fabs(P->phits - HALFPI) >= EPS10 ? + cos(P->phits) / tan(FORTPI - .5 * P->phits) : + 2. * P->k0 ; + break; + } + P->inv = s_inverse; + P->fwd = s_forward; + } + return P; +} +ENTRY0(stere) + P->phits = pj_param(P->params, "tlat_ts").i ? + P->phits = pj_param(P->params, "rlat_ts").f : HALFPI; +ENDENTRY(setup(P)) +ENTRY0(ups) + /* International Ellipsoid */ + P->phi0 = pj_param(P->params, "bsouth").i ? - HALFPI: HALFPI; + if (!P->es) E_ERROR(-34); + P->k0 = .994; + P->x0 = 2000000.; + P->y0 = 2000000.; + P->phits = HALFPI; + P->lam0 = 0.; +ENDENTRY(setup(P)) diff --git a/src/PJ_sts.c b/src/PJ_sts.c new file mode 100644 index 00000000..e3caca75 --- /dev/null +++ b/src/PJ_sts.c @@ -0,0 +1,57 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_sts.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x, C_y, C_p; \ + int tan_mode; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(kav5, "Kavraisky V") "\n\tPCyl., Sph."; +PROJ_HEAD(qua_aut, "Quartic Authalic") "\n\tPCyl., Sph."; +PROJ_HEAD(mbt_s, "McBryde-Thomas Flat-Polar Sine (No. 1)") "\n\tPCyl., Sph."; +PROJ_HEAD(fouc, "Foucaut") "\n\tPCyl., Sph."; +FORWARD(s_forward); /* spheroid */ + double c; + + xy.x = P->C_x * lp.lam * cos(lp.phi); + xy.y = P->C_y; + lp.phi *= P->C_p; + c = cos(lp.phi); + if (P->tan_mode) { + xy.x *= c * c; + xy.y *= tan(lp.phi); + } else { + xy.x /= c; + xy.y *= sin(lp.phi); + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double c; + + xy.y /= P->C_y; + c = cos(lp.phi = P->tan_mode ? atan(xy.y) : aasin(xy.y)); + lp.phi /= P->C_p; + lp.lam = xy.x / (P->C_x * cos(lp.phi /= P->C_p)); + if (P->tan_mode) + lp.lam /= c * c; + else + lp.lam *= c; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P, double p, double q, int mode) { + P->es = 0.; + P->inv = s_inverse; + P->fwd = s_forward; + P->C_x = q / p; + P->C_y = p; + P->C_p = 1/ q; + P->tan_mode = mode; + return P; +} +ENTRY0(kav5) ENDENTRY(setup(P, 1.50488, 1.35439, 0)) +ENTRY0(qua_aut) ENDENTRY(setup(P, 2., 2., 0)) +ENTRY0(mbt_s) ENDENTRY(setup(P, 1.48875, 1.36509, 0)) +ENTRY0(fouc) ENDENTRY(setup(P, 2., 2., 1)) diff --git a/src/PJ_tcc.c b/src/PJ_tcc.c new file mode 100644 index 00000000..feb2d4e9 --- /dev/null +++ b/src/PJ_tcc.c @@ -0,0 +1,20 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_tcc.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double ap; +#define EPS10 1.e-10 +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(tcc, "Transverse Central Cylindrical") "\n\tCyl, Sph, no inv."; +FORWARD(s_forward); /* spheroid */ + double b, bt; + + b = cos(lp.phi) * sin(lp.lam); + if ((bt = 1. - b * b) < EPS10) F_ERROR; + xy.x = b / sqrt(bt); + xy.y = atan2(tan(lp.phi) , cos(lp.lam)); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(tcc) P->es = 0.; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_tcea.c b/src/PJ_tcea.c new file mode 100644 index 00000000..caa8ab61 --- /dev/null +++ b/src/PJ_tcea.c @@ -0,0 +1,30 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_tcea.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double rk0; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(tcea, "Transverse Cylindrical Equal Area") "\n\tCyl, Sph"; +FORWARD(s_forward); /* spheroid */ + xy.x = P->rk0 * cos(lp.phi) * sin(lp.lam); + xy.y = P->k0 * (atan2(tan(lp.phi), cos(lp.lam)) - P->phi0); + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t; + + xy.y = xy.y * P->rk0 + P->phi0; + xy.x *= P->k0; + t = sqrt(1. - xy.x * xy.x); + lp.phi = asin(t * sin(xy.y)); + lp.lam = atan2(xy.x, t * cos(xy.y)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(tcea) + P->rk0 = 1 / P->k0; + P->inv = s_inverse; + P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_tmerc.c b/src/PJ_tmerc.c new file mode 100644 index 00000000..bac2db3e --- /dev/null +++ b/src/PJ_tmerc.c @@ -0,0 +1,148 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_tmerc.c 4.2 94/06/02 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double esp; \ + double ml0; \ + double *en; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(tmerc, "Transverse Mercator") "\n\tCyl, Sph&Ell"; +PROJ_HEAD(utm, "Universal Transverse Mercator (UTM)") + "\n\tCyl, Sph\n\tzone= south"; +#define EPS10 1.e-10 +#define aks0 P->esp +#define aks5 P->ml0 +#define FC1 1. +#define FC2 .5 +#define FC3 .16666666666666666666 +#define FC4 .08333333333333333333 +#define FC5 .05 +#define FC6 .03333333333333333333 +#define FC7 .02380952380952380952 +#define FC8 .01785714285714285714 +FORWARD(e_forward); /* ellipse */ + double al, als, n, cosphi, sinphi, t; + + sinphi = sin(lp.phi); cosphi = cos(lp.phi); + t = fabs(cosphi) > 1e-10 ? sinphi/cosphi : 0.; + t *= t; + al = cosphi * lp.lam; + als = al * al; + al /= sqrt(1. - P->es * sinphi * sinphi); + n = P->esp * cosphi * cosphi; + xy.x = P->k0 * al * (FC1 + + FC3 * als * (1. - t + n + + FC5 * als * (5. + t * (t - 18.) + n * (14. - 58. * t) + + FC7 * als * (61. + t * ( t * (179. - t) - 479. ) ) + ))); + xy.y = P->k0 * (pj_mlfn(lp.phi, sinphi, cosphi, P->en) - P->ml0 + + sinphi * al * lp.lam * FC2 * ( 1. + + FC4 * als * (5. - t + n * (9. + 4. * n) + + FC6 * als * (61. + t * (t - 58.) + n * (270. - 330 * t) + + FC8 * als * (1385. + t * ( t * (543. - t) - 3111.) ) + )))); + return (xy); +} +FORWARD(s_forward); /* sphere */ + double b, cosphi; + + b = (cosphi = cos(lp.phi)) * sin(lp.lam); + if (fabs(fabs(b) - 1.) <= EPS10) F_ERROR; + xy.x = aks5 * log((1. + b) / (1. - b)); + if ((b = fabs( xy.y = cosphi * cos(lp.lam) / sqrt(1. - b * b) )) >= 1.) { + if ((b - 1.) > EPS10) F_ERROR + else xy.y = 0.; + } else + xy.y = acos(xy.y); + if (lp.phi < 0.) xy.y = -xy.y; + xy.y = aks0 * (xy.y - P->phi0); + return (xy); +} +INVERSE(e_inverse); /* ellipsoid */ + double n, con, cosphi, d, ds, sinphi, t; + + lp.phi = pj_inv_mlfn(P->ml0 + xy.y / P->k0, P->es, P->en); + if (fabs(lp.phi) >= HALFPI) { + lp.phi = xy.y < 0. ? -HALFPI : HALFPI; + lp.lam = 0.; + } else { + sinphi = sin(lp.phi); + cosphi = cos(lp.phi); + t = fabs(cosphi) > 1e-10 ? sinphi/cosphi : 0.; + n = P->esp * cosphi * cosphi; + d = xy.x * sqrt(con = 1. - P->es * sinphi * sinphi) / P->k0; + con *= t; + t *= t; + ds = d * d; + lp.phi -= (con * ds / (1.-P->es)) * FC2 * (1. - + ds * FC4 * (5. + t * (3. - 9. * n) + n * (1. - 4 * n) - + ds * FC6 * (61. + t * (90. - 252. * n + + 45. * t) + 46. * n + - ds * FC8 * (1385. + t * (3633. + t * (4095. + 1574. * t)) ) + ))); + lp.lam = d*(FC1 - + ds*FC3*( 1. + 2.*t + n - + ds*FC5*(5. + t*(28. + 24.*t + 8.*n) + 6.*n + - ds * FC7 * (61. + t * (662. + t * (1320. + 720. * t)) ) + ))) / cosphi; + } + return (lp); +} +INVERSE(s_inverse); /* sphere */ + double h, g; + + h = exp(xy.x / aks0); + g = .5 * (h - 1. / h); + h = cos(P->phi0 + xy.y / aks0); + lp.phi = asin(sqrt((1. - h * h) / (1. + g * g))); + if (xy.y < 0.) lp.phi = -lp.phi; + lp.lam = (g || h) ? atan2(g, h) : 0.; + return (lp); +} +FREEUP; + if (P) { + if (P->en) + pj_dalloc(P->en); + pj_dalloc(P); + } +} + static PJ * +setup(PJ *P) { /* general initialization */ + if (P->es) { + if (!(P->en = pj_enfn(P->es))) + E_ERROR_0; + P->ml0 = pj_mlfn(P->phi0, sin(P->phi0), cos(P->phi0), P->en); + P->esp = P->es / (1. - P->es); + P->inv = e_inverse; + P->fwd = e_forward; + } else { + aks0 = P->k0; + aks5 = .5 * aks0; + P->inv = s_inverse; + P->fwd = s_forward; + } + return P; +} +ENTRY1(tmerc, en) +ENDENTRY(setup(P)) +ENTRY1(utm, en) + int zone; + + if (!P->es) E_ERROR(-34); + P->y0 = pj_param(P->params, "bsouth").i ? 10000000. : 0.; + P->x0 = 500000.; + if (pj_param(P->params, "tzone").i) /* zone input ? */ + if ((zone = pj_param(P->params, "izone").i) > 0 && zone <= 60) + --zone; + else + E_ERROR(-35) + else /* nearest central meridian input */ + if ((zone = floor((adjlon(P->lam0) + PI) * 30. / PI)) < 0) + zone = 0; + else if (zone >= 60) + zone = 59; + P->lam0 = (zone + .5) * PI / 30. - PI; + P->k0 = 0.9996; + P->phi0 = 0.; +ENDENTRY(setup(P)) diff --git a/src/PJ_tpeqd.c b/src/PJ_tpeqd.c new file mode 100644 index 00000000..ae9eb98a --- /dev/null +++ b/src/PJ_tpeqd.c @@ -0,0 +1,79 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_tpeqd.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double cp1, sp1, cp2, sp2, ccs, cs, sc, r2z0, z02, dlam2; \ + double hz0, thz0, rhshz0, ca, sa, lp, lamc; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(tpeqd, "Two Point Equidistant") + "\n\tMisc Sph\n\tlat_1= lon_1= lat_2= lon_2="; +FORWARD(s_forward); /* sphere */ + double t, z1, z2, dl1, dl2, sp, cp; + + sp = sin(lp.phi); + cp = cos(lp.phi); + z1 = aacos(P->sp1 * sp + P->cp1 * cp * cos(dl1 = lp.lam + P->dlam2)); + z2 = aacos(P->sp2 * sp + P->cp2 * cp * cos(dl2 = lp.lam - P->dlam2)); + z1 *= z1; + z2 *= z2; + xy.x = P->r2z0 * (t = z1 - z2); + t = P->z02 - t; + xy.y = P->r2z0 * asqrt(4. * P->z02 * z2 - t * t); + if ((P->ccs * sp - cp * (P->cs * sin(dl1) - P->sc * sin(dl2))) < 0.) + xy.y = -xy.y; + return xy; +} +INVERSE(s_inverse); /* sphere */ + double cz1, cz2, s, d, cp, sp; + + cz1 = cos(hypot(xy.y, xy.x + P->hz0)); + cz2 = cos(hypot(xy.y, xy.x - P->hz0)); + s = cz1 + cz2; + d = cz1 - cz2; + lp.lam = - atan2(d, (s * P->thz0)); + lp.phi = aacos(hypot(P->thz0 * s, d) * P->rhshz0); + if ( xy.y < 0. ) + lp.phi = - lp.phi; + /* lam--phi now in system relative to P1--P2 base equator */ + sp = sin(lp.phi); + cp = cos(lp.phi); + lp.phi = aasin(P->sa * sp + P->ca * cp * (s = cos(lp.lam -= P->lp))); + lp.lam = atan2(cp * sin(lp.lam), P->sa * cp * s - P->ca * sp) + P->lamc; + return lp; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(tpeqd) + double lam_1, lam_2, phi_1, phi_2, A12, pp; + + /* get control point locations */ + phi_1 = pj_param(P->params, "rlat_1").f; + lam_1 = pj_param(P->params, "rlon_1").f; + phi_2 = pj_param(P->params, "rlat_2").f; + lam_2 = pj_param(P->params, "rlon_2").f; + if (phi_1 == phi_2 && lam_1 == lam_2) E_ERROR(-25); + P->lam0 = adjlon(0.5 * (lam_1 + lam_2)); + P->dlam2 = adjlon(lam_2 - lam_1); + P->cp1 = cos(phi_1); + P->cp2 = cos(phi_2); + P->sp1 = sin(phi_1); + P->sp2 = sin(phi_2); + P->cs = P->cp1 * P->sp2; + P->sc = P->sp1 * P->cp2; + P->ccs = P->cp1 * P->cp2 * sin(P->dlam2); + P->z02 = aacos(P->sp1 * P->sp2 + P->cp1 * P->cp2 * cos(P->dlam2)); + P->hz0 = .5 * P->z02; + A12 = atan2(P->cp2 * sin(P->dlam2), + P->cp1 * P->sp2 - P->sp1 * P->cp2 * cos(P->dlam2)); + P->ca = cos(pp = aasin(P->cp1 * sin(A12))); + P->sa = sin(pp); + P->lp = adjlon(atan2(P->cp1 * cos(A12), P->sp1) - P->hz0); + P->dlam2 *= .5; + P->lamc = HALFPI - atan2(sin(A12) * P->sp1, cos(A12)) - P->dlam2; + P->thz0 = tan(P->hz0); + P->rhshz0 = .5 / sin(P->hz0); + P->r2z0 = 0.5 / P->z02; + P->z02 *= P->z02; + P->inv = s_inverse; P->fwd = s_forward; + P->es = 0.; +ENDENTRY(P) diff --git a/src/PJ_urm5.c b/src/PJ_urm5.c new file mode 100644 index 00000000..32cf29bf --- /dev/null +++ b/src/PJ_urm5.c @@ -0,0 +1,31 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_urm5.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double m, rmn, q3, n; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(urm5, "Urmaev V") "\n\tPCyl., Sph.\n\tn= q= alphi="; +FORWARD(s_forward); /* spheroid */ + double t; + + t = lp.phi = aasin(P->n * sin(lp.phi)); + xy.x = P->m * lp.lam * cos(lp.phi); + t *= t; + xy.y = lp.phi * (1. + t * P->q3) * P->rmn; + return xy; +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(urm5) + double alpha, t; + + P->n = pj_param(P->params, "dn").f; + P->q3 = pj_param(P->params, "dq").f / 3.; + alpha = pj_param(P->params, "ralpha").f; + t = P->n * sin(alpha); + P->m = cos(alpha) / sqrt(1. - t * t); + P->rmn = 1. / (P->m * P->n); + P->es = 0.; + P->inv = 0; + P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_urmfps.c b/src/PJ_urmfps.c new file mode 100644 index 00000000..912be1d9 --- /dev/null +++ b/src/PJ_urmfps.c @@ -0,0 +1,43 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_urmfps.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double n, C_y; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(urmfps, "Urmaev Flat-Polar Sinusoidal") "\n\tPCyl, Sph.\n\tn="; +PROJ_HEAD(wag1, "Wagner I (Kavraisky VI)") "\n\tPCyl, Sph."; +#define C_x 0.8773826753 +#define Cy 1.139753528477 +FORWARD(s_forward); /* sphere */ + lp.phi = aasin(P->n * sin(lp.phi)); + xy.x = C_x * lp.lam * cos(lp.phi); + xy.y = P->C_y * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* sphere */ + xy.y /= P->C_y; + lp.phi = aasin(sin(xy.y) / P->n); + lp.lam = xy.x / (C_x * cos(xy.y)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } + static PJ * +setup(PJ *P) { + P->C_y = Cy / P->n; + P->es = 0.; + P->inv = s_inverse; + P->fwd = s_forward; + return P; +} +ENTRY0(urmfps) + if (pj_param(P->params, "tn").i) { + P->n = pj_param(P->params, "dn").f; + if (P->n <= 0. || P->n > 1.) + E_ERROR(-40) + } else + E_ERROR(-40) +ENDENTRY(setup(P)) +ENTRY0(wag1) + P->n = 0.8660254037844386467637231707; +ENDENTRY(setup(P)) diff --git a/src/PJ_vandg.c b/src/PJ_vandg.c new file mode 100644 index 00000000..b6168e06 --- /dev/null +++ b/src/PJ_vandg.c @@ -0,0 +1,81 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_vandg.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(vandg, "van der Grinten (I)") "\n\tMisc Sph"; +# define TOL 1.e-10 +# define THIRD .33333333333333333333 +# define TWO_THRD .66666666666666666666 +# define C2_27 .07407407407407407407 +# define PI4_3 4.18879020478639098458 +# define PISQ 9.86960440108935861869 +# define TPISQ 19.73920880217871723738 +# define HPISQ 4.93480220054467930934 +FORWARD(s_forward); /* spheroid */ + double al, al2, g, g2, p2; + + p2 = fabs(lp.phi / HALFPI); + if ((p2 - TOL) > 1.) F_ERROR; + if (p2 > 1.) + p2 = 1.; + if (fabs(lp.phi) <= TOL) { + xy.x = lp.lam; + xy.y = 0.; + } else if (fabs(lp.lam) <= TOL || fabs(p2 - 1.) < TOL) { + xy.x = 0.; + xy.y = PI * tan(.5 * asin(p2)); + if (lp.phi < 0.) xy.y = -xy.y; + } else { + al = .5 * fabs(PI / lp.lam - lp.lam / PI); + al2 = al * al; + g = sqrt(1. - p2 * p2); + g = g / (p2 + g - 1.); + g2 = g * g; + p2 = g * (2. / p2 - 1.); + p2 = p2 * p2; + xy.x = g - p2; g = p2 + al2; + xy.x = PI * (al * xy.x + sqrt(al2 * xy.x * xy.x - g * (g2 - p2))) / g; + if (lp.lam < 0.) xy.x = -xy.x; + xy.y = fabs(xy.x / PI); + xy.y = 1. - xy.y * (xy.y + 2. * al); + if (xy.y < -TOL) F_ERROR; + if (xy.y < 0.) xy.y = 0.; + else xy.y = sqrt(xy.y) * (lp.phi < 0. ? -PI : PI); + } + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + double t, c0, c1, c2, c3, al, r2, r, m, d, ay, x2, y2; + + x2 = xy.x * xy.x; + if ((ay = fabs(xy.y)) < TOL) { + lp.phi = 0.; + t = x2 * x2 + TPISQ * (x2 + HPISQ); + lp.lam = fabs(xy.x) <= TOL ? 0. : + .5 * (x2 - PISQ + sqrt(t)) / xy.x; + return (lp); + } + y2 = xy.y * xy.y; + r = x2 + y2; r2 = r * r; + c1 = - PI * ay * (r + PISQ); + c3 = r2 + TWOPI * (ay * r + PI * (y2 + PI * (ay + HALFPI))); + c2 = c1 + PISQ * (r - 3. * y2); + c0 = PI * ay; + c2 /= c3; + al = c1 / c3 - THIRD * c2 * c2; + m = 2. * sqrt(-THIRD * al); + d = C2_27 * c2 * c2 * c2 + (c0 * c0 - THIRD * c2 * c1) / c3; + if (((t = fabs(d = 3. * d / (al * m))) - TOL) <= 1.) { + d = t > 1. ? (d > 0. ? 0. : PI) : acos(d); + lp.phi = PI * (m * cos(d * THIRD + PI4_3) - THIRD * c2); + if (xy.y < 0.) lp.phi = -lp.phi; + t = r2 + TPISQ * (x2 - y2 + HPISQ); + lp.lam = fabs(xy.x) <= TOL ? 0. : + .5 * (r - PISQ + (t <= 0. ? 0. : sqrt(t))) / xy.x; + } else + I_ERROR; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(vandg) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_vandg2.c b/src/PJ_vandg2.c new file mode 100644 index 00000000..7e96a5c6 --- /dev/null +++ b/src/PJ_vandg2.c @@ -0,0 +1,48 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_vandg2.c 4.1 94/02/15 GIE REL"; +#endif +# define TOL 1e-10 +# define TWORPI 0.63661977236758134308 +#define PROJ_PARMS__ \ + int vdg3; +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(vandg2, "van der Grinten II") "\n\tMisc Sph, no inv."; +PROJ_HEAD(vandg3, "van der Grinten III") "\n\tMisc Sph, no inv."; +FORWARD(s_forward); /* spheroid */ + double x1, at, bt, ct; + + bt = fabs(TWORPI * lp.phi); + if ((ct = 1. - bt * bt) < 0.) + ct = 0.; + else + ct = sqrt(ct); + if (fabs(lp.lam) < TOL) { + xy.x = 0.; + xy.y = PI * (lp.phi < 0. ? -bt : bt) / (1. + ct); + } else { + at = 0.5 * fabs(PI / lp.lam - lp.lam / PI); + if (P->vdg3) { + x1 = bt / (1. + ct); + xy.x = PI * (sqrt(at * at + 1. - x1 * x1) - at); + xy.y = PI * x1; + } else { + x1 = (ct * sqrt(1. + at * at) - at * ct * ct) / + (1. + at * at * bt * bt); + xy.x = PI * x1; + xy.y = PI * sqrt(1. - x1 * (x1 + 2. * at) + TOL); + } + if ( lp.lam < 0.) xy.x = -xy.x; + if ( lp.phi < 0.) xy.y = -xy.y; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(vandg2) + P->vdg3 = 0; + P->inv = 0; P->fwd = s_forward; +ENDENTRY(P) +ENTRY0(vandg3) + P->vdg3 = 1; + P->es = 0.; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_vandg4.c b/src/PJ_vandg4.c new file mode 100644 index 00000000..9789bf97 --- /dev/null +++ b/src/PJ_vandg4.c @@ -0,0 +1,44 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_vandg4.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(vandg4, "van der Grinten IV") "\n\tMisc Sph, no inv."; +#define TOL 1e-10 +#define TWORPI 0.63661977236758134308 +FORWARD(s_forward); /* spheroid */ + double x1, t, bt, ct, ft, bt2, ct2, dt, dt2; + + if (fabs(lp.phi) < TOL) { + xy.x = lp.lam; + xy.y = 0.; + } else if (fabs(lp.lam) < TOL || fabs(fabs(lp.phi) - HALFPI) < TOL) { + xy.x = 0.; + xy.y = lp.phi; + } else { + bt = fabs(TWORPI * lp.phi); + bt2 = bt * bt; + ct = 0.5 * (bt * (8. - bt * (2. + bt2)) - 5.) + / (bt2 * (bt - 1.)); + ct2 = ct * ct; + dt = TWORPI * lp.lam; + dt = dt + 1. / dt; + dt = sqrt(dt * dt - 4.); + if ((fabs(lp.lam) - HALFPI) < 0.) dt = -dt; + dt2 = dt * dt; + x1 = bt + ct; x1 *= x1; + t = bt + 3.*ct; + ft = x1 * (bt2 + ct2 * dt2 - 1.) + (1.-bt2) * ( + bt2 * (t * t + 4. * ct2) + + ct2 * (12. * bt * ct + 4. * ct2) ); + x1 = (dt*(x1 + ct2 - 1.) + 2.*sqrt(ft)) / + (4.* x1 + dt2); + xy.x = HALFPI * x1; + xy.y = HALFPI * sqrt(1. + dt * fabs(x1) - x1 * x1); + if (lp.lam < 0.) xy.x = -xy.x; + if (lp.phi < 0.) xy.y = -xy.y; + } + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(vandg4) P->es = 0.; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_wag2.c b/src/PJ_wag2.c new file mode 100644 index 00000000..d6a0e3f2 --- /dev/null +++ b/src/PJ_wag2.c @@ -0,0 +1,24 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_wag2.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(wag2, "Wagner II") "\n\tPCyl., Sph."; +#define C_x 0.92483 +#define C_y 1.38725 +#define C_p1 0.88022 +#define C_p2 0.88550 +FORWARD(s_forward); /* spheroid */ + lp.phi = aasin(C_p1 * sin(C_p2 * lp.phi)); + xy.x = C_x * lp.lam * cos(lp.phi); + xy.y = C_y * lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y / C_y; + lp.lam = xy.x / (C_x * cos(lp.phi)); + lp.phi = aasin(sin(lp.phi) / C_p1) / C_p2; + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(wag2) P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; ENDENTRY(P) diff --git a/src/PJ_wag3.c b/src/PJ_wag3.c new file mode 100644 index 00000000..30b1a38a --- /dev/null +++ b/src/PJ_wag3.c @@ -0,0 +1,27 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_wag3.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double C_x; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(wag3, "Wagner III") "\n\tPCyl., Sph."; +#define TWOTHIRD 0.6666666666666666666667 +FORWARD(s_forward); /* spheroid */ + xy.x = P->C_x * lp.lam * cos(TWOTHIRD * lp.phi); + xy.y = lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y; + lp.lam = xy.x / (P->C_x * cos(TWOTHIRD * lp.phi)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(wag3) + double ts; + + ts = pj_param(P->params, "rlat_ts").f; + P->C_x = cos(ts) / cos(2.*ts/3.); + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_wag7.c b/src/PJ_wag7.c new file mode 100644 index 00000000..7fd5e58d --- /dev/null +++ b/src/PJ_wag7.c @@ -0,0 +1,17 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_wag7.c 4.1 94/02/15 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +PROJ_HEAD(wag7, "Wagner VII") "\n\tMisc Sph, no inv."; +FORWARD(s_forward); /* sphere */ + double theta, ct, D; + + theta = asin(xy.y = 0.90630778703664996 * sin(lp.phi)); + xy.x = 2.66723 * (ct = cos(theta)) * sin(lp.lam /= 3.); + xy.y *= 1.24104 * (D = 1/(sqrt(0.5 * (1 + ct * cos(lp.lam))))); + xy.x *= D; + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(wag7) P->fwd = s_forward; P->inv = 0; P->es = 0.; ENDENTRY(P) diff --git a/src/PJ_wink1.c b/src/PJ_wink1.c new file mode 100644 index 00000000..bee666e6 --- /dev/null +++ b/src/PJ_wink1.c @@ -0,0 +1,23 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_wink1.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double cosphi1; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(wink1, "Winkel I") "\n\tPCyl., Sph.\n\tlat_ts="; +FORWARD(s_forward); /* spheroid */ + xy.x = .5 * lp.lam * (P->cosphi1 + cos(lp.phi)); + xy.y = lp.phi; + return (xy); +} +INVERSE(s_inverse); /* spheroid */ + lp.phi = xy.y; + lp.lam = 2. * xy.x / (P->cosphi1 + cos(lp.phi)); + return (lp); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(wink1) + P->cosphi1 = cos(pj_param(P->params, "rlat_ts").f); + P->es = 0.; P->inv = s_inverse; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/PJ_wink2.c b/src/PJ_wink2.c new file mode 100644 index 00000000..2e8c0a75 --- /dev/null +++ b/src/PJ_wink2.c @@ -0,0 +1,37 @@ +#ifndef lint +static const char SCCSID[]="@(#)PJ_wink2.c 4.1 94/02/15 GIE REL"; +#endif +#define PROJ_PARMS__ \ + double cosphi1; +#define PJ_LIB__ +# include <projects.h> +PROJ_HEAD(wink2, "Winkel II") "\n\tPCyl., Sph., no inv.\n\tlat_1="; +#define MAX_ITER 10 +#define LOOP_TOL 1e-7 +#define TWO_D_PI 0.636619772367581343 +FORWARD(s_forward); /* spheroid */ + double k, V; + int i; + + xy.y = lp.phi * TWO_D_PI; + k = PI * sin(lp.phi); + lp.phi *= 1.8; + for (i = MAX_ITER; i ; --i) { + lp.phi -= V = (lp.phi + sin(lp.phi) - k) / + (1. + cos(lp.phi)); + if (fabs(V) < LOOP_TOL) + break; + } + if (!i) + lp.phi = (lp.phi < 0.) ? -HALFPI : HALFPI; + else + lp.phi *= 0.5; + xy.x = 0.5 * lp.lam * (cos(lp.phi) + P->cosphi1); + xy.y = FORTPI * (sin(lp.phi) + xy.y); + return (xy); +} +FREEUP; if (P) pj_dalloc(P); } +ENTRY0(wink2) + P->cosphi1 = cos(pj_param(P->params, "rlat_1").f); + P->es = 0.; P->inv = 0; P->fwd = s_forward; +ENDENTRY(P) diff --git a/src/README b/src/README new file mode 100644 index 00000000..35c60a4e --- /dev/null +++ b/src/README @@ -0,0 +1,73 @@ + Installation README --- @(#)README 4.4 94/10/05 GIE REL" + +At the current time, installation only performed to PROJ.4 directory and +information not transfered via normal "install(1)" function because of +the diversity of system variations. + +There are occasional errors encountered with "ranlib." Makefile tests +for presence in either /bin or /usr/bin and will execute. Even if found, +some systems choke. Such choking is ignored with no apparent ill results. + +As an alternative to editing the head of the Makefile, the following can +be used on the run line: + +For Suns without vendor ANSI C compiler, use GNU's gcc and + make install CC=gcc COMP='-O -DNO_STRERRNO' +Apparently the name max is missing from gcc includes and the Sun +library does not include the ANSI strerrno function. + +For DEC Ultrix: (brain damaged strtod implementation) + make install STRTOD='$L(strtod.o)' +The DEC people just can't seem to forget the dinosaur FORTRAN. +Ignore compiler warnings about "unimplemented const." + +For Dell SVR4 issue 2.2 do + make install + +For Data General: + make install COMP='-O -ansi' +Ranlib in system but execution denied(?)---error ignored. + +If repeatative compilations or linkages are expected, it is better +to edit these flags into the beginning of the Makefile after saving +a copy of the original. + +Check /usr/include/math.h for prototype of hypot. If missing it is +probably not in libm.a and it is necessary to use supplied version. + + make install HYPOT='$L(hypot.o)' + or + make install HYPOT='$L(hypot.o)' STRTOD='$L(strtod.o)' + +To check for brain damaged versions of strtod try the following after +using the local system's version (default): + +proj +proj=poly +ellps=clrk66 +no_defs <<EOF +3.5 33.25 +3d30 33d15 +EOF + +Both geographic coordinates should produce the same cartesian result. +If not, then it is almost a certainty that libc.a has a version modified +to accept d | D as an alternative to e | E. This "extension" to ANSI +specifications causes untold grief. Use the ANSI compliant GNU version +included. + +The default installation library is set at /usr/local/lib even though +actual transfer of files not made. To set to an alternative library +use LIB=<library path> on the make run-line or edit Makefile. + +To truely install: + + BIN=<favorite executable area? + LIB=<basic library area, same as in Makefile's> + INC=<include file area> + cp proj $BIN + ln ${BIN}/proj ${BIN}/invproj + cp geod $BIN + cp proj_def.dat $LIB/proj + cp libproj.a $LIB + cp projects.h $INC + cd ../nad + cp nad27 $LIB/proj + cp nad83 $LIB/proj diff --git a/src/aasincos.c b/src/aasincos.c new file mode 100644 index 00000000..27aab829 --- /dev/null +++ b/src/aasincos.c @@ -0,0 +1,36 @@ +/* arc sin, cosine, tan2 and sqrt that will NOT fail */ +#ifndef lint +static const char SCCSID[]="@(#)aasincos.c 4.6 93/12/12 GIE REL"; +#endif +#include <projects.h> +#define ONE_TOL 1.00000000000001 +#define TOL 0.000000001 +#define ATOL 1e-50 + double +aasin(double v) { + double av; + + if ((av = fabs(v)) >= 1.) { + if (av > ONE_TOL) + pj_errno = -19; + return (v < 0. ? -HALFPI : HALFPI); + } + return asin(v); +} + double +aacos(double v) { + double av; + + if ((av = fabs(v)) >= 1.) { + if (av > ONE_TOL) + pj_errno = -19; + return (v < 0. ? PI : 0.); + } + return acos(v); +} + double +asqrt(double v) { return ((v <= 0) ? 0. : sqrt(v)); } + double +aatan2(double n, double d) { + return ((fabs(n) < ATOL && fabs(d) < ATOL) ? 0. : atan2(n,d)); +} diff --git a/src/adjlon.c b/src/adjlon.c new file mode 100644 index 00000000..3de12a16 --- /dev/null +++ b/src/adjlon.c @@ -0,0 +1,16 @@ +/* reduce argument to range +/- PI */ +#ifndef lint +static const char SCCSID[]="@(#)adjlon.c 4.3 93/06/12 GIE REL"; +#endif +#include <math.h> +/* note: PI adjusted high +** approx. true val: 3.14159265358979323844 +*/ +#define SPI 3.14159265359 +#define TWOPI 6.2831853071795864769 + double +adjlon (double lon) { + while ( fabs(lon) > SPI ) + lon += lon < 0. ? TWOPI : -TWOPI; + return( lon ); +} diff --git a/src/bch2bps.c b/src/bch2bps.c new file mode 100644 index 00000000..0d773575 --- /dev/null +++ b/src/bch2bps.c @@ -0,0 +1,143 @@ +/* convert bivariate w Chebyshev series to w Power series */ +#ifndef lint +static const char SCCSID[]="@(#)bch2bps.c 4.5 94/03/22 GIE REL"; +#endif +#include <projects.h> +/* basic support procedures */ + static void /* clear vector to zero */ +clear(UV *p, int n) { static const UV c = {0., 0.}; while (n--) *p++ = c; } + static void /* clear matrix rows to zero */ +bclear(UV **p, int n, int m) { while (n--) clear(*p++, m); } + static void /* move vector */ +bmove(UV *a, UV *b, int n) { while (n--) *a++ = *b++; } + static void /* a <- m * b - c */ +submop(UV *a, double m, UV *b, UV *c, int n) { + while (n--) { + a->u = m * b->u - c->u; + a++->v = m * b++->v - c++->v; + } +} + static void /* a <- b - c */ +subop(UV *a, UV *b, UV *c, int n) { + while (n--) { + a->u = b->u - c->u; + a++->v = b++->v - c++->v; + } +} + static void /* multiply vector a by scalar m */ +dmult(UV *a, double m, int n) { while(n--) { a->u *= m; a->v *= m; ++a; } } + static void /* row adjust a[] <- a[] - m * b[] */ +dadd(UV *a, UV *b, double m, int n) { + while(n--) { + a->u -= m * b->u; + a++->v -= m * b++->v; + } +} + static void /* convert row to pover series */ +rows(UV *c, UV *d, int n) { + UV sv, *dd; + int j, k; + + dd = (UV *)vector1(n-1, sizeof(UV)); + sv.u = sv.v = 0.; + for (j = 0; j < n; ++j) d[j] = dd[j] = sv; + d[0] = c[n-1]; + for (j = n-2; j >= 1; --j) { + for (k = n-j; k >= 1; --k) { + sv = d[k]; + d[k].u = 2. * d[k-1].u - dd[k].u; + d[k].v = 2. * d[k-1].v - dd[k].v; + dd[k] = sv; + } + sv = d[0]; + d[0].u = -dd[0].u + c[j].u; + d[0].v = -dd[0].v + c[j].v; + dd[0] = sv; + } + for (j = n-1; j >= 1; --j) { + d[j].u = d[j-1].u - dd[j].u; + d[j].v = d[j-1].v - dd[j].v; + } + d[0].u = -dd[0].u + .5 * c[0].u; + d[0].v = -dd[0].v + .5 * c[0].v; + pj_dalloc(dd); +} + static void /* convert columns to power series */ +cols(UV **c, UV **d, int nu, int nv) { + UV *sv, **dd; + int j, k; + + dd = (UV **)vector2(nu, nv, sizeof(UV)); + sv = (UV *)vector1(nv, sizeof(UV)); + bclear(d, nu, nv); + bclear(dd, nu, nv); + bmove(d[0], c[nu-1], nv); + for (j = nu-2; j >= 1; --j) { + for (k = nu-j; k >= 1; --k) { + bmove(sv, d[k], nv); + submop(d[k], 2., d[k-1], dd[k], nv); + bmove(dd[k], sv, nv); + } + bmove(sv, d[0], nv); + subop(d[0], c[j], dd[0], nv); + bmove(dd[0], sv, nv); + } + for (j = nu-1; j >= 1; --j) + subop(d[j], d[j-1], dd[j], nv); + submop(d[0], .5, c[0], dd[0], nv); + freev2(dd, nu); + pj_dalloc(sv); +} + static void /* row adjust for range -1 to 1 to a to b */ +rowshft(double a, double b, UV *d, int n) { + int k, j; + double fac, cnst; + + cnst = 2. / (b - a); + fac = cnst; + for (j = 1; j < n; ++j) { + d[j].u *= fac; + d[j].v *= fac; + fac *= cnst; + } + cnst = .5 * (a + b); + for (j = 0; j <= n-2; ++j) + for (k = n - 2; k >= j; --k) { + d[k].u -= cnst * d[k+1].u; + d[k].v -= cnst * d[k+1].v; + } +} + static void /* column adjust for range -1 to 1 to a to b */ +colshft(double a, double b, UV **d, int n, int m) { + int k, j; + double fac, cnst; + + cnst = 2. / (b - a); + fac = cnst; + for (j = 1; j < n; ++j) { + dmult(d[j], fac, m); + fac *= cnst; + } + cnst = .5 * (a + b); + for (j = 0; j <= n-2; ++j) + for (k = n - 2; k >= j; --k) + dadd(d[k], d[k+1], cnst, m); +} + int /* entry point */ +bch2bps(UV a, UV b, UV **c, int nu, int nv) { + UV **d; + int i; + + if (nu < 1 || nv < 1 || !(d = (UV **)vector2(nu, nv, sizeof(UV)))) + return 0; + /* do rows to power series */ + for (i = 0; i < nu; ++i) { + rows(c[i], d[i], nv); + rowshft(a.v, b.v, d[i], nv); + } + /* do columns to power series */ + cols(d, c, nu, nv); + colshft(a.u, b.u, c, nu, nv); + freev2(d, nu); + return 1; +} diff --git a/src/bchgen.c b/src/bchgen.c new file mode 100644 index 00000000..cc03f037 --- /dev/null +++ b/src/bchgen.c @@ -0,0 +1,61 @@ +/* generate double bivariate Chebychev polynomial */ +#ifndef lint +static const char SCCSID[]="@(#)bchgen.c 4.5 94/03/22 GIE REL"; +#endif +#include <projects.h> + int +bchgen(UV a, UV b, int nu, int nv, UV **f, UV(*func)(UV)) { + int i, j, k; + UV arg, *t, bma, bpa, *c; + double d, fac; + + bma.u = 0.5 * (b.u - a.u); bma.v = 0.5 * (b.v - a.v); + bpa.u = 0.5 * (b.u + a.u); bpa.v = 0.5 * (b.v + a.v); + for ( i = 0; i < nu; ++i) { + arg.u = cos(PI * (i + 0.5) / nu) * bma.u + bpa.u; + for ( j = 0; j < nv; ++j) { + arg.v = cos(PI * (j + 0.5) / nv) * bma.v + bpa.v; + f[i][j] = (*func)(arg); + if ((f[i][j]).u == HUGE_VAL) + return(1); + } + } + if (!(c = vector1(nu, sizeof(UV)))) return 1; + fac = 2. / nu; + for ( j = 0; j < nv ; ++j) { + for ( i = 0; i < nu; ++i) { + arg.u = arg.v = 0.; + for (k = 0; k < nu; ++k) { + d = cos(PI * i * (k + .5) / nu); + arg.u += f[k][j].u * d; + arg.v += f[k][j].v * d; + } + arg.u *= fac; + arg.v *= fac; + c[i] = arg; + } + for (i = 0; i < nu; ++i) + f[i][j] = c[i]; + } + pj_dalloc(c); + if (!(c = vector1(nv, sizeof(UV)))) return 1; + fac = 2. / nv; + for ( i = 0; i < nu; ++i) { + t = f[i]; + for (j = 0; j < nv; ++j) { + arg.u = arg.v = 0.; + for (k = 0; k < nv; ++k) { + d = cos(PI * j * (k + .5) / nv); + arg.u += t[k].u * d; + arg.v += t[k].v * d; + } + arg.u *= fac; + arg.v *= fac; + c[j] = arg; + } + f[i] = c; + c = t; + } + pj_dalloc(c); + return(0); +} diff --git a/src/biveval.c b/src/biveval.c new file mode 100644 index 00000000..3dcd7461 --- /dev/null +++ b/src/biveval.c @@ -0,0 +1,83 @@ +/* procedures for evaluating Tseries */ +#ifndef lint +static const char SCCSID[]="@(#)biveval.c 4.4 93/06/12 GIE REL"; +#endif +# include <projects.h> +# define NEAR_ONE 1.00001 + static UV +w2, w; + static double /* basic bivariate Chebyshev evaluation */ +ceval(C, n) struct PW_COEF *C; { + double d=0, dd=0, vd, vdd, tmp, *c; + int j; + + for (C += n ; n-- ; --C ) { + if (j = C->m) { + vd = vdd = 0.; + for (c = C->c + --j; j ; --j ) { + vd = w2.v * (tmp = vd) - vdd + *c--; + vdd = tmp; + } + d = w2.u * (tmp = d) - dd + w.v * vd - vdd + 0.5 * *c; + } else + d = w2.u * (tmp = d) - dd; + dd = tmp; + } + if (j = C->m) { + vd = vdd = 0.; + for (c = C->c + --j; j ; --j ) { + vd = w2.v * (tmp = vd) - vdd + *c--; + vdd = tmp; + } + return (w.u * d - dd + 0.5 * ( w.v * vd - vdd + 0.5 * *c )); + } else + return (w.u * d - dd); +} + UV /* bivariate Chebyshev polynomial entry point */ +bcheval(UV in, Tseries *T) { + UV out; + /* scale to +-1 */ + w.u = ( in.u + in.u - T->a.u ) * T->b.u; + w.v = ( in.v + in.v - T->a.v ) * T->b.v; + if (fabs(w.u) > NEAR_ONE || fabs(w.v) > NEAR_ONE) { + out.u = out.v = HUGE_VAL; + pj_errno = -36; + } else { /* double evaluation */ + w2.u = w.u + w.u; + w2.v = w.v + w.v; + out.u = ceval(T->cu, T->mu); + out.v = ceval(T->cv, T->mv); + } + return out; +} + UV /* bivariate power polynomial entry point */ +bpseval(UV in, Tseries *T) { + UV out; + double *c, row; + int i, m; + + out.u = out.v = 0.; + for (i = T->mu; i >= 0; --i) { + row = 0.; + if (m = T->cu[i].m) { + c = T->cu[i].c + m; + while (m--) + row = *--c + in.v * row; + } + out.u = row + in.u * out.u; + } + for (i = T->mv; i >= 0; --i) { + row = 0.; + if (m = T->cv[i].m) { + c = T->cv[i].c + m; + while (m--) + row = *--c + in.v * row; + } + out.v = row + in.u * out.v; + } + return out; +} + UV /* general entry point selecting evaluation mode */ +biveval(UV in, Tseries *T) { + return (T->power ? bpseval(in, T) : bcheval(in, T)); +} diff --git a/src/dmstor.c b/src/dmstor.c new file mode 100644 index 00000000..5b4bccf1 --- /dev/null +++ b/src/dmstor.c @@ -0,0 +1,78 @@ +/* Convert DMS string to radians */ +#ifndef lint +static const char SCCSID[]="@(#)dmstor.c 4.4 93/06/16 GIE REL"; +#endif +#include <projects.h> +#include <string.h> +#include <ctype.h> + +/* following should be sufficient for all but the rediculous */ +#define MAX_WORK 64 + static const char +*sym = "NnEeSsWw"; + static const double +vm[] = { + .0174532925199433, + .0002908882086657216, + .0000048481368110953599 +}; + double +dmstor(const char *is, char **rs) { + int sign, n, nl; + char *p, *s, work[MAX_WORK]; + double v, tv; + + if (rs) + *rs = (char *)is; + /* copy sting into work space */ + while (isspace(sign = *is)) ++is; + for (n = MAX_WORK, s = work, p = (char *)is; isgraph(*p) && --n ; ) + *s++ = *p++; + *s = '\0'; + /* it is possible that a really odd input (like lots of leading + zeros) could be truncated in copying into work. But ... */ + sign = *(s = work); + if (sign == '+' || sign == '-') s++; + else sign = '+'; + for (v = 0., nl = 0 ; nl < 3 ; nl = n + 1 ) { + if (!(isdigit(*s) || *s == '.')) break; + if ((tv = strtod(s, &s)) == HUGE_VAL) + return tv; + switch (*s) { + case 'D': case 'd': + n = 0; break; + case '\'': + n = 1; break; + case '"': + n = 2; break; + case 'r': case 'R': + if (nl) { + pj_errno = -16; + return HUGE_VAL; + } + ++s; + v = tv; + goto skip; + default: + v += tv * vm[nl]; + skip: n = 4; + continue; + } + if (n < nl) { + pj_errno = -16; + return HUGE_VAL; + } + v += tv * vm[n]; + ++s; + } + /* postfix sign */ + if (*s && (p = strchr(sym, *s))) { + sign = (p - sym) >= 4 ? '-' : '+'; + ++s; + } + if (sign == '-') + v = -v; + if (rs) /* return point of next char after valid string */ + *rs = (char *)is + (s - work); + return v; +} diff --git a/src/emess.c b/src/emess.c new file mode 100644 index 00000000..9e357f9f --- /dev/null +++ b/src/emess.c @@ -0,0 +1,50 @@ +/* Error message processing */ +#ifndef lint +static const char SCCSID[]="@(#)emess.c 4.6 94/05/24 GIE REL"; +#endif + +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <errno.h> +#include <string.h> +#define EMESS_ROUTINE +#include "emess.h" +extern char const pj_release[]; + void +emess(int code, char *fmt, ...) { + va_list args; + + va_start(args, fmt); + /* prefix program name, if given */ + if (fmt != NULL) + (void)fprintf(stderr,"%s\n<%s>: ",pj_release,emess_dat.Prog_name); + /* print file name and line, if given */ + if (emess_dat.File_name != NULL && *emess_dat.File_name) { + (void)fprintf(stderr,"while processing file: %s", emess_dat.File_name); + if (emess_dat.File_line > 0) + (void)fprintf(stderr,", line %d\n", emess_dat.File_line); + else + (void)fputc('\n', stderr); + } else + putc('\n', stderr); + /* if |code|==2, print errno code data */ + if (code == 2 || code == -2) + (void)fprintf(stderr, "Sys errno: %d: %s\n", + errno, +#ifdef HAVE_STRERROR + strerror(errno)); +#else + "<system mess. texts unavail.>"); +#endif + /* post remainder of call data */ + (void)vfprintf(stderr,fmt,args); + va_end(args); + /* die if code positive */ + if (code > 0) { + (void)fputs("\nprogram abnormally terminated\n", stderr); + exit(code); + } + else + putc('\n', stderr); +} diff --git a/src/emess.h b/src/emess.h new file mode 100644 index 00000000..6724a065 --- /dev/null +++ b/src/emess.h @@ -0,0 +1,32 @@ +/* Error message processing header file */ +#ifndef EMESS_H +#define EMESS_H + +#ifndef lint +static char EMESS_H_ID[] = "@(#)emess.h 4.1 93/03/08 GIE REL"; +#endif + +struct EMESS { + char *File_name, /* input file name */ + *Prog_name; /* name of program */ + int File_line; /* approximate line read + where error occured */ +}; + +#ifdef EMESS_ROUTINE /* use type */ +/* for emess procedure */ +struct EMESS emess_dat = { (char *)0, (char *)0, 0 }; + +#ifdef sun /* Archaic SunOs 4.1.1, etc. */ +extern char *sys_errlist[]; +#define strerror(n) (sys_errlist[n]) +#endif + +#else /* for for calling procedures */ + +extern struct EMESS emess_dat; +void emess(int, char *, ...); + +#endif /* use type */ + +#endif /* end EMESS_H */ diff --git a/src/gen_cheb.c b/src/gen_cheb.c new file mode 100644 index 00000000..14ac3ce9 --- /dev/null +++ b/src/gen_cheb.c @@ -0,0 +1,74 @@ +/* generates 'T' option output */ +#ifndef lint +static const char SCCSID[]="@(#)gen_cheb.c 4.9 95/09/23 GIE REL"; +#endif +#define PJ_LIB__ +#include <stdio.h> +#include <string.h> +#include <errno.h> +#include <projects.h> +#include "emess.h" +#ifndef COEF_LINE_MAX +#define COEF_LINE_MAX 60 +#endif + void +gen_cheb(int inverse, UV (*proj)(), char *s, PJ *P, int iargc, char **iargv) { + int NU = 15, NV = 15, i, res = -1, errin = 0, pwr; + char *arg, fmt[15]; + UV low, upp, resid; + Tseries *F; + extern void p_series(Tseries *, FILE *, char *); + double (*input)(); + + input = inverse ? strtod : dmstor; + if (*s) low.u = input(s, &s); else ++errin; + if (*s == ',') upp.u = input(s+1, &s); else ++errin; + if (*s == ',') low.v = input(s+1, &s); else ++errin; + if (*s == ',') upp.v = input(s+1, &s); else ++errin; + if (errin) + emess(16,"null or absent -T parameters"); + if (*s == ',') if (*++s != ',') res = strtol(s, &s, 10); + if (*s == ',') if (*++s != ',') NU = strtol(s, &s, 10); + if (*s == ',') if (*++s != ',') NV = strtol(s, &s, 10); + pwr = s && *s && !strcmp(s, ",P"); + (void)printf("#proj_%s\n# run-line:\n", + pwr ? "Power" : "Chebyshev"); + if (iargc > 0) { /* proj execution audit trail */ + int n = 0, L; + + for( i = 0 ; iargc ; --iargc) { + arg = *iargv++; + if (*arg != '+') { + if (!n) { putchar('#'); ++n; } + (void)printf(" %s%n",arg, &L); + if ((n += L) > 50) { putchar('\n'); n = 0; } + } + } + if (n) putchar('\n'); + } + (void)printf("# projection parameters\n"); + pj_pr_list(P); + if (low.u == upp.u || low.v >= upp.v) + emess(16,"approx. argument range error"); + if (low.u > upp.u) + low.u -= TWOPI; + if (NU < 2 || NV < 2) + emess(16,"approx. work dimensions (%d %d) too small",NU,NV); + if (!(F = mk_cheby(low, upp, pow(10., (double)res)*.5, &resid, proj, + NU, NV, pwr))) + emess(16,"generation of approx failed\nreason: %s\n", + pj_strerrno(errno)); + (void)printf("%c,%.12g,%.12g,%.12g,%.12g,%.12g\n",inverse?'I':'F', + P->lam0*RAD_TO_DEG, + low.u*(inverse?1.:RAD_TO_DEG),upp.u*(inverse?1.:RAD_TO_DEG), + low.v*(inverse?1.:RAD_TO_DEG),upp.v*(inverse?1.:RAD_TO_DEG)); + if (pwr) + strcpy(fmt, "%.15g"); + else if (res <= 0) + (void)sprintf(fmt,"%%.%df",-res+1); + else + (void)strcpy(fmt,"%.0f"); + p_series(F, stdout, fmt); + (void)printf("# |u,v| sums %g %g\n#end_proj_%s\n", + resid.u, resid.v, pwr ? "Power" : "Chebyshev"); +} diff --git a/src/geod.c b/src/geod.c new file mode 100644 index 00000000..3be15024 --- /dev/null +++ b/src/geod.c @@ -0,0 +1,242 @@ +#ifndef lint +static const char SCCSID[]="@(#)geod.c 4.8 95/09/23 GIE REL"; +#endif +/* <<<< Geodesic filter program >>>> */ +# include "projects.h" +# include <stdio.h> +# include "geodesic.h" +# include "emess.h" +# include <ctype.h> +# include <string.h> + +# define MAXLINE 200 +# define MAX_PARGS 50 +# define TAB putchar('\t') + static int +fullout = 0, /* output full set of geodesic values */ +tag = '#', /* beginning of line tag character */ +pos_azi = 0, /* output azimuths as positive values */ +inverse = 0; /* != 0 then inverse geodesic */ + static char +*oform = (char *)0, /* output format for decimal degrees */ +*osform = "%.3f", /* output format for S */ +pline[50], /* work string */ +*usage = +"%s\nusage: %s [ -afFIptTwW [args] ] [ +opts[=arg] ] [ files ]\n"; + static void +printLL(double p, double l) { + if (oform) { + (void)printf(oform, p * RAD_TO_DEG); TAB; + (void)printf(oform, l * RAD_TO_DEG); + } else { + (void)fputs(rtodms(pline, p, 'N', 'S'),stdout); TAB; + (void)fputs(rtodms(pline, l, 'E', 'W'),stdout); + } +} + static void +do_arc(void) { + double az; + + printLL(phi2, lam2); putchar('\n'); + for (az = al12; n_alpha--; ) { + al12 = az = adjlon(az + del_alpha); + geod_pre(); + geod_for(); + printLL(phi2, lam2); putchar('\n'); + } +} + static void /* generate intermediate geodesic coordinates */ +do_geod(void) { + double phil, laml, del_S; + + phil = phi2; + laml = lam2; + printLL(phi1, lam1); putchar('\n'); + for ( S = del_S = S / n_S; --n_S; S += del_S) { + geod_for(); + printLL(phi2, lam2); putchar('\n'); + } + printLL(phil, laml); putchar('\n'); +} + void static /* file processing function */ +process(FILE *fid) { + char line[MAXLINE+3], *s; + + for (;;) { + ++emess_dat.File_line; + if (!(s = fgets(line, MAXLINE, fid))) + break; + if (!strchr(s, '\n')) { /* overlong line */ + int c; + strcat(s, "\n"); + /* gobble up to newline */ + while ((c = fgetc(fid)) != EOF && c != '\n') ; + } + if (*s == tag) { + fputs(line, stdout); + continue; + } + phi1 = dmstor(s, &s); + lam1 = dmstor(s, &s); + if (inverse) { + phi2 = dmstor(s, &s); + lam2 = dmstor(s, &s); + geod_inv(); + } else { + al12 = dmstor(s, &s); + S = strtod(s, &s) * to_meter; + geod_pre(); + geod_for(); + } + if (!*s && (s > line)) --s; /* assumed we gobbled \n */ + if (pos_azi) { + if (al12 < 0.) al12 += TWOPI; + if (al21 < 0.) al21 += TWOPI; + } + if (fullout) { + printLL(phi1, lam1); TAB; + printLL(phi2, lam2); TAB; + if (oform) { + (void)printf(oform, al12 * RAD_TO_DEG); TAB; + (void)printf(oform, al21 * RAD_TO_DEG); TAB; + (void)printf(osform, S * fr_meter); + } else { + (void)fputs(rtodms(pline, al12, 0, 0), stdout); TAB; + (void)fputs(rtodms(pline, al21, 0, 0), stdout); TAB; + (void)printf(osform, S * fr_meter); + } + } else if (inverse) + if (oform) { + (void)printf(oform, al12 * RAD_TO_DEG); TAB; + (void)printf(oform, al21 * RAD_TO_DEG); TAB; + (void)printf(osform, S * fr_meter); + } else { + (void)fputs(rtodms(pline, al12, 0, 0), stdout); TAB; + (void)fputs(rtodms(pline, al21, 0, 0), stdout); TAB; + (void)printf(osform, S * fr_meter); + } + else { + printLL(phi2, lam2); TAB; + if (oform) + (void)printf(oform, al21 * RAD_TO_DEG); + else + (void)fputs(rtodms(pline, al21, 0, 0), stdout); + } + (void)fputs(s, stdout); + } +} + static char +*pargv[MAX_PARGS]; + static int +pargc = 0; + void +main(int argc, char **argv) { + char *arg, **eargv = argv, *strnchr(); + FILE *fid; + static int eargc = 0, c; + + if (emess_dat.Prog_name = strrchr(*argv,'/')) ++emess_dat.Prog_name; + else emess_dat.Prog_name = *argv; + inverse = ! strncmp(emess_dat.Prog_name, "inv", 3); + if (argc <= 1 ) { + (void)fprintf(stderr, usage, pj_release, emess_dat.Prog_name); + exit (0); + } + /* process run line arguments */ + while (--argc > 0) { /* collect run line arguments */ + if(**++argv == '-') for(arg = *argv;;) { + switch(*++arg) { + case '\0': /* position of "stdin" */ + if (arg[-1] == '-') eargv[eargc++] = "-"; + break; + case 'a': /* output full set of values */ + fullout = 1; + continue; + case 'I': /* alt. inverse spec. */ + inverse = 1; + continue; + case 't': /* set col. one char */ + if (arg[1]) tag = *++arg; + else emess(1,"missing -t col. 1 tag"); + continue; + case 'W': /* specify seconds precision */ + case 'w': /* -W for constant field width */ + if ((c = arg[1]) && isdigit(c)) { + set_rtodms(c - '0', *arg == 'W'); + ++arg; + } else + emess(1,"-W argument missing or non-digit"); + continue; + case 'f': /* alternate output format degrees or xy */ + if (--argc <= 0) +noargument: emess(1,"missing argument for -%c",*arg); + oform = *++argv; + continue; + case 'F': /* alternate output format degrees or xy */ + if (--argc <= 0) goto noargument; + osform = *++argv; + continue; + case 'l': + if (!arg[1] || arg[1] == 'e') { /* list of ellipsoids */ + struct PJ_ELLPS *le; + + for (le = pj_ellps; le->id ; ++le) + (void)printf("%9s %-16s %-16s %s\n", + le->id, le->major, le->ell, le->name); + emess(1,"invalid list option: l%c",arg[1]); + emess(1,"-l[p|e] terminates program"); + } else if (arg[1] == 'u') { /* list of units */ + struct PJ_UNITS *lu; + + for (lu = pj_units; lu->id ; ++lu) + (void)printf("%12s %-20s %s\n", + lu->id, lu->to_meter, lu->name); + } else + emess(1,"invalid list option: l%c",arg[1]); + emess(1,"will not proceed after display list option"); + case 'p': /* output azimuths as positive */ + pos_azi = 1; + continue; + default: + emess(1, "invalid option: -%c",*arg); + break; + } + break; + } else if (**argv == '+') /* + argument */ + if (pargc < MAX_PARGS) + pargv[pargc++] = *argv + 1; + else + emess(1,"overflowed + argument table"); + else /* assumed to be input file name(s) */ + eargv[eargc++] = *argv; + } + /* done with parameter and control input */ + geod_set(pargc, pargv); /* setup projection */ + if ((n_alpha || n_S) && eargc) + emess(1,"files specified for arc/geodesic mode"); + if (n_alpha) + do_arc(); + else if (n_S) + do_geod(); + else { /* process input file list */ + if (eargc == 0) /* if no specific files force sysin */ + eargv[eargc++] = "-"; + for ( ; eargc-- ; ++eargv) { + if (**eargv == '-') { + fid = stdin; + emess_dat.File_name = "<stdin>"; + } else { + if ((fid = fopen(*eargv, "r")) == NULL) { + emess(-2, *eargv, "input file"); + continue; + } + emess_dat.File_name = *eargv; + } + emess_dat.File_line = 0; + process(fid); + (void)fclose(fid); + emess_dat.File_name = (char *)0; + } + } + exit(0); /* normal completion */ +} diff --git a/src/geod_for.c b/src/geod_for.c new file mode 100644 index 00000000..3411f0f5 --- /dev/null +++ b/src/geod_for.c @@ -0,0 +1,106 @@ +#ifndef lint +static const char SCCSID[]="@(#)geod_for.c 4.6 95/09/23 GIE REL"; +#endif +# include "projects.h" +# include "geodesic.h" +# define MERI_TOL 1e-9 + static double +th1,costh1,sinth1,sina12,cosa12,M,N,c1,c2,D,P,s1; + static int +merid, signS; + void +geod_pre(void) { + al12 = adjlon(al12); /* reduce to +- 0-PI */ + signS = fabs(al12) > HALFPI ? 1 : 0; + th1 = ellipse ? atan(onef * tan(phi1)) : phi1; + costh1 = cos(th1); + sinth1 = sin(th1); + if ((merid = fabs(sina12 = sin(al12)) < MERI_TOL)) { + sina12 = 0.; + cosa12 = fabs(al12) < HALFPI ? 1. : -1.; + M = 0.; + } else { + cosa12 = cos(al12); + M = costh1 * sina12; + } + N = costh1 * cosa12; + if (ellipse) { + if (merid) { + c1 = 0.; + c2 = f4; + D = 1. - c2; + D *= D; + P = c2 / D; + } else { + c1 = f * M; + c2 = f4 * (1. - M * M); + D = (1. - c2)*(1. - c2 - c1 * M); + P = (1. + .5 * c1 * M) * c2 / D; + } + } + if (merid) s1 = HALFPI - th1; + else { + s1 = (fabs(M) >= 1.) ? 0. : acos(M); + s1 = sinth1 / sin(s1); + s1 = (fabs(s1) >= 1.) ? 0. : acos(s1); + } +} + void +geod_for(void) { + double d,sind,u,V,X,ds,cosds,sinds,ss,de; + + if (ellipse) { + d = S / (D * a); + if (signS) d = -d; + u = 2. * (s1 - d); + V = cos(u + d); + X = c2 * c2 * (sind = sin(d)) * cos(d) * (2. * V * V - 1.); + ds = d + X - 2. * P * V * (1. - 2. * P * cos(u)) * sind; + ss = s1 + s1 - ds; + } else { + ds = S / a; + if (signS) ds = - ds; + } + cosds = cos(ds); + sinds = sin(ds); + if (signS) sinds = - sinds; + al21 = N * cosds - sinth1 * sinds; + if (merid) { + phi2 = atan( tan(HALFPI + s1 - ds) / onef); + if (al21 > 0.) { + al21 = PI; + if (signS) + de = PI; + else { + phi2 = - phi2; + de = 0.; + } + } else { + al21 = 0.; + if (signS) { + phi2 = - phi2; + de = 0; + } else + de = PI; + } + } else { + al21 = atan(M / al21); + if (al21 > 0) + al21 += PI; + if (al12 < 0.) + al21 -= PI; + al21 = adjlon(al21); + phi2 = atan(-(sinth1 * cosds + N * sinds) * sin(al21) / + (ellipse ? onef * M : M)); + de = atan2(sinds * sina12 , + (costh1 * cosds - sinth1 * sinds * cosa12)); + if (ellipse) + if (signS) + de += c1 * ((1. - c2) * ds + + c2 * sinds * cos(ss)); + else + de -= c1 * ((1. - c2) * ds - + c2 * sinds * cos(ss)); + } + lam2 = adjlon( lam1 + de ); +} diff --git a/src/geod_inv.c b/src/geod_inv.c new file mode 100644 index 00000000..f41d58af --- /dev/null +++ b/src/geod_inv.c @@ -0,0 +1,59 @@ +#ifndef lint +static const char SCCSID[]="@(#)geod_inv.c 4.5 95/09/23 GIE REL"; +#endif +# include "projects.h" +# include "geodesic.h" +# define DTOL 1e-12 + void +geod_inv(void) { + double th1,th2,thm,dthm,dlamm,dlam,sindlamm,costhm,sinthm,cosdthm, + sindthm,L,E,cosd,d,X,Y,T,sind,tandlammp,u,v,D,A,B; + + if (ellipse) { + th1 = atan(onef * tan(phi1)); + th2 = atan(onef * tan(phi2)); + } else { + th1 = phi1; + th2 = phi2; + } + thm = .5 * (th1 + th2); + dthm = .5 * (th2 - th1); + dlamm = .5 * ( dlam = adjlon(lam2 - lam1) ); + if (fabs(dlam) < DTOL && fabs(dthm) < DTOL) { + al12 = al21 = S = 0.; + return; + } + sindlamm = sin(dlamm); + costhm = cos(thm); sinthm = sin(thm); + cosdthm = cos(dthm); sindthm = sin(dthm); + L = sindthm * sindthm + (cosdthm * cosdthm - sinthm * sinthm) + * sindlamm * sindlamm; + d = acos(cosd = 1 - L - L); + if (ellipse) { + E = cosd + cosd; + sind = sin( d ); + Y = sinthm * cosdthm; + Y *= (Y + Y) / (1. - L); + T = sindthm * costhm; + T *= (T + T) / L; + X = Y + T; + Y -= T; + T = d / sind; + D = 4. * T * T; + A = D * E; + B = D + D; + S = a * sind * (T - f4 * (T * X - Y) + + f64 * (X * (A + (T - .5 * (A - E)) * X) - + Y * (B + E * Y) + D * X * Y)); + tandlammp = tan(.5 * (dlam - .25 * (Y + Y - E * (4. - X)) * + (f2 * T + f64 * (32. * T - (20. * T - A) + * X - (B + 4.) * Y)) * tan(dlam))); + } else { + S = a * d; + tandlammp = tan(dlamm); + } + u = atan2(sindthm , (tandlammp * costhm)); + v = atan2(cosdthm , (tandlammp * sinthm)); + al12 = adjlon(TWOPI + v - u); + al21 = adjlon(TWOPI - v - u); +} diff --git a/src/geod_set.c b/src/geod_set.c new file mode 100644 index 00000000..76cea729 --- /dev/null +++ b/src/geod_set.c @@ -0,0 +1,72 @@ +#ifndef lint +static const char SCCSID[]="@(#)geod_set.c 4.8 95/09/23 GIE REL"; +#endif +#include "projects.h" +#include "geodesic.h" + void +geod_set(int argc, char **argv) { + paralist *start = 0, *curr; + double es; + char *name; + int i; + + /* put arguments into internal linked list */ + if (argc <= 0) + emess(1, "no arguments in initialization list"); + for (i = 0; i < argc; ++i) + if (i) + curr = curr->next = pj_mkparam(argv[i]); + else + start = curr = pj_mkparam(argv[i]); + /* set elliptical parameters */ + if (pj_ell_set(start, &a, &es)) emess(1,"ellipse setup failure"); + /* set units */ + if (name = pj_param(start, "sunits").s) { + char *s; + + for (i = 0; (s = pj_units[i].id) && strcmp(name, s) ; ++i) ; + if (!s) + emess(1,"%s unknown unit conversion id", name); + fr_meter = 1. / (to_meter = atof(pj_units[i].to_meter)); + } else + to_meter = fr_meter = 1.; + if (ellipse = es != 0.) { + onef = sqrt(1. - es); + f = 1 - onef; + f2 = f/2; + f4 = f/4; + f64 = f*f/64; + } else { + onef = 1.; + f = f2 = f4 = f64 = 0.; + } + /* check if line or arc mode */ + if (pj_param(start, "tlat_1").i) { + double del_S; +#undef f + phi1 = pj_param(start, "rlat_1").f; + lam1 = pj_param(start, "rlon_1").f; + if (pj_param(start, "tlat_2").i) { + phi2 = pj_param(start, "rlat_2").f; + lam2 = pj_param(start, "rlon_2").f; + geod_inv(); + geod_pre(); + } else if (S = pj_param(start, "dS").f) { + al12 = pj_param(start, "rA").f; + geod_pre(); + geod_for(); + } else emess(1,"incomplete geodesic/arc info"); + if ((n_alpha = pj_param(start, "in_A").i) > 0) { + if (!(del_alpha = pj_param(start, "rdel_A").f)) + emess(1,"del azimuth == 0"); + } else if (del_S = fabs(pj_param(start, "ddel_S").f)) { + n_S = S / del_S + .5; + } else if ((n_S = pj_param(start, "in_S").i) <= 0) + emess(1,"no interval divisor selected"); + } + /* free up linked list */ + for ( ; start; start = curr) { + curr = start->next; + pj_dalloc(start); + } +} diff --git a/src/geodesic.h b/src/geodesic.h new file mode 100644 index 00000000..8454b222 --- /dev/null +++ b/src/geodesic.h @@ -0,0 +1,35 @@ +#ifndef lint +static char GEODESIC_H_ID[] = "@(#)geodesic.h 4.3 95/08/19 GIE REL"; +#endif +extern double dmstor(); +struct geodesic { + double A; + double LAM1, PHI1, ALPHA12; + double LAM2, PHI2, ALPHA21; + double DIST; + double ONEF, FLAT, FLAT2, FLAT4, FLAT64; + int ELLIPSE; +} GEODESIC; +# define a GEODESIC.A +# define lam1 GEODESIC.LAM1 +# define phi1 GEODESIC.PHI1 +# define al12 GEODESIC.ALPHA12 +# define lam2 GEODESIC.LAM2 +# define phi2 GEODESIC.PHI2 +# define al21 GEODESIC.ALPHA21 +# define S GEODESIC.DIST +# define f GEODESIC.FLAT +# define onef GEODESIC.ONEF +# define f2 GEODESIC.FLAT2 +# define f4 GEODESIC.FLAT4 +# define ff2 GEODESIC.FLAT4 +# define f64 GEODESIC.FLAT64 +# define ellipse GEODESIC.ELLIPSE + int +n_alpha, n_S; + double +to_meter, fr_meter, del_alpha; +void geod_set(int, char **); +void geod_for(void); +void geod_prefor(void); +void geod_inv(void); diff --git a/src/hypot.c b/src/hypot.c new file mode 100644 index 00000000..269c146b --- /dev/null +++ b/src/hypot.c @@ -0,0 +1,39 @@ +#ifndef lint +static const char SCCSID[]="@(#)hypot.c 4.4 93/06/12 GIE REL"; +#endif +/* hypot - sqrt(x * x + y * y) +** +** Because this was omitted from the ANSI standards, this version +** is included for those systems that do not include hypot as an +** extension to libm.a. Note: GNU version was not used because it +** was not properly coded to minimize potential overflow. +** +** The proper technique for determining hypot is to factor out the +** larger of the two terms, thus leaving a possible case of float +** overflow when max(x,y)*sqrt(2) > max machine value. This allows +** a wider range of numbers than the alternative of the sum of the +** squares < max machine value. For an Intel x87 IEEE double of +** approximately 1.8e308, only argument values > 1.27e308 are at +** risk of causing overflow. Whereas, not using this method limits +** the range to values less that 9.5e153 --- a considerable reduction +** in range! +*/ +extern double sqrt(double); + double +hypot(double x, double y) { + if ( x < 0.) + x = -x; + else if (x == 0.) + return (y < 0. ? -y : y); + if (y < 0.) + y = -y; + else if (y == 0.) + return (x); + if ( x < y ) { + x /= y; + return ( y * sqrt( 1. + x * x ) ); + } else { + y /= x; + return ( x * sqrt( 1. + y * y ) ); + } +} diff --git a/src/mk_cheby.c b/src/mk_cheby.c new file mode 100644 index 00000000..65b47890 --- /dev/null +++ b/src/mk_cheby.c @@ -0,0 +1,164 @@ +#ifndef lint +static const char SCCSID[]="@(#)mk_cheby.c 4.5 94/03/22 GIE REL"; +#endif +#include <projects.h> + static void /* sum coefficients less than res */ +eval(UV **w, int nu, int nv, double res, UV *resid) { + int i, j; + double ab; + UV *s; + + resid->u = resid->v = 0.; + for (i = 0; i < nu; ++i) + for (s = w[i], j = 0; j < nv; ++j, ++s) { + if ((ab = fabs(s->u)) < res) + resid->u += ab; + if ((ab = fabs(s->v)) < res) + resid->v += ab; + } +} + static Tseries * /* create power series structure */ +makeT(int nru, int nrv) { + Tseries *T; + int i; + + if ((T = (Tseries *)pj_malloc(sizeof(Tseries))) && + (T->cu = (struct PW_COEF *)pj_malloc( + sizeof(struct PW_COEF) * nru)) && + (T->cv = (struct PW_COEF *)pj_malloc( + sizeof(struct PW_COEF) * nrv))) { + for (i = 0; i < nru; ++i) + T->cu[i].c = 0; + for (i = 0; i < nrv; ++i) + T->cv[i].c = 0; + return T; + } else + return 0; +} + Tseries * +mk_cheby(UV a, UV b, double res, UV *resid, UV (*func)(UV), + int nu, int nv, int power) { + int j, i, nru, nrv, *ncu, *ncv; + Tseries *T; + UV **w; + double cutres; + + if (!(w = (UV **)vector2(nu, nv, sizeof(UV))) || + !(ncu = (int *)vector1(nu + nv, sizeof(int)))) + return 0; + ncv = ncu + nu; + if (!bchgen(a, b, nu, nv, w, func)) { + UV *s; + double ab, *p; + + /* analyse coefficients and adjust until residual OK */ + cutres = res; + for (i = 4; i ; --i) { + eval(w, nu, nv, cutres, resid); + if (resid->u < res && resid->v < res) + break; + cutres *= 0.5; + } + if (i <= 0) /* warn of too many tries */ + resid->u = - resid->u; + /* apply cut resolution and set pointers */ + nru = nrv = 0; + for (j = 0; j < nu; ++j) { + ncu[j] = ncv[j] = 0; /* clear column maxes */ + for (s = w[j], i = 0; i < nv; ++i, ++s) { + if ((ab = fabs(s->u)) < cutres) /* < resolution ? */ + s->u = 0.; /* clear coefficient */ + else + ncu[j] = i + 1; /* update column max */ + if ((ab = fabs(s->v)) < cutres) /* same for v coef's */ + s->v = 0.; + else + ncv[j] = i + 1; + } + if (ncu[j]) nru = j + 1; /* update row max */ + if (ncv[j]) nrv = j + 1; + } + if (power) { /* convert to bivariate power series */ + if (!bch2bps(a, b, w, nu, nv)) + goto error; + /* possible change in some row counts, so readjust */ + nru = nrv = 0; + for (j = 0; j < nu; ++j) { + ncu[j] = ncv[j] = 0; /* clear column maxes */ + for (s = w[j], i = 0; i < nv; ++i, ++s) { + if (s->u) + ncu[j] = i + 1; /* update column max */ + if (s->v) + ncv[j] = i + 1; + } + if (ncu[j]) nru = j + 1; /* update row max */ + if (ncv[j]) nrv = j + 1; + } + if (T = makeT(nru, nrv)) { + T->a = a; + T->b = b; + T->mu = nru - 1; + T->mv = nrv - 1; + T->power = 1; + for (i = 0; i < nru; ++i) /* store coefficient rows for u */ + if (T->cu[i].m = ncu[i]) + if ((p = T->cu[i].c = + (double *)pj_malloc(sizeof(double) * ncu[i]))) + for (j = 0; j < ncu[i]; ++j) + *p++ = (w[i] + j)->u; + else + goto error; + for (i = 0; i < nrv; ++i) /* same for v */ + if (T->cv[i].m = ncv[i]) + if ((p = T->cv[i].c = + (double *)pj_malloc(sizeof(double) * ncv[i]))) + for (j = 0; j < ncv[i]; ++j) + *p++ = (w[i] + j)->v; + else + goto error; + } + } else if (T = makeT(nru, nrv)) { + /* else make returned Chebyshev coefficient structure */ + T->mu = nru - 1; /* save row degree */ + T->mv = nrv - 1; + T->a.u = a.u + b.u; /* set argument scaling */ + T->a.v = a.v + b.v; + T->b.u = 1. / (b.u - a.u); + T->b.v = 1. / (b.v - a.v); + T->power = 0; + for (i = 0; i < nru; ++i) /* store coefficient rows for u */ + if (T->cu[i].m = ncu[i]) + if ((p = T->cu[i].c = + (double *)pj_malloc(sizeof(double) * ncu[i]))) + for (j = 0; j < ncu[i]; ++j) + *p++ = (w[i] + j)->u; + else + goto error; + for (i = 0; i < nrv; ++i) /* same for v */ + if (T->cv[i].m = ncv[i]) + if ((p = T->cv[i].c = + (double *)pj_malloc(sizeof(double) * ncv[i]))) + for (j = 0; j < ncv[i]; ++j) + *p++ = (w[i] + j)->v; + else + goto error; + } else + goto error; + } + goto gohome; +error: + if (T) { /* pj_dalloc up possible allocations */ + for (i = 0; i <= T->mu; ++i) + if (T->cu[i].c) + pj_dalloc(T->cu[i].c); + for (i = 0; i <= T->mv; ++i) + if (T->cv[i].c) + pj_dalloc(T->cv[i].c); + pj_dalloc(T); + } + T = 0; +gohome: + freev2(w, nu); + pj_dalloc(ncu); + return T; +} diff --git a/src/nad2bin.c b/src/nad2bin.c new file mode 100644 index 00000000..3cf5c34e --- /dev/null +++ b/src/nad2bin.c @@ -0,0 +1,68 @@ +/* Convert bivariate ASCII NAD27 to NAD83 tables to binary structure */ +#ifndef lint +static const char SCCSID[]="@(#)nad2bin.c 4.2 93/08/25 GIE REL"; +#endif +#include <stdio.h> +#include <stdlib.h> +#define PJ_LIB__ +#include <projects.h> +#define U_SEC_TO_RAD 4.848136811095359935899141023e-12 + static char +*usage = "<ASCII_dist_table local_bin_table"; + void +main(int argc, char **argv) { + struct CTABLE ct; + FLP *p, t; + size_t tsize; + int i, j, ichk; + long lam, laml, phi, phil; + FILE *bin; + + if (argc != 2) { + fprintf(stderr,"usage: %s %s\n", argv[0], usage); + exit(1); + } + fgets(ct.id, MAX_TAB_ID, stdin); + scanf("%d %d %*d %lf %lf %lf %lf", &ct.lim.lam, &ct.lim.phi, + &ct.ll.lam, &ct.del.lam, &ct.ll.phi, &ct.del.phi); + if (!(ct.cvs = (FLP *)malloc(tsize = ct.lim.lam * ct.lim.phi * + sizeof(FLP)))) { + perror("mem. alloc"); + exit(1); + } + ct.ll.lam *= DEG_TO_RAD; + ct.ll.phi *= DEG_TO_RAD; + ct.del.lam *= DEG_TO_RAD; + ct.del.phi *= DEG_TO_RAD; + /* load table */ + for (p = ct.cvs, i = 0; i < ct.lim.phi; ++i) { + scanf("%d:%ld %ld", &ichk, &laml, &phil); + if (ichk != i) { + fprintf(stderr,"format check on row\n"); + exit(1); + } + t.lam = laml * U_SEC_TO_RAD; + t.phi = phil * U_SEC_TO_RAD; + *p++ = t; + for (j = 1; j < ct.lim.lam; ++j) { + scanf("%ld %ld", &lam, &phi); + t.lam = (laml += lam) * U_SEC_TO_RAD; + t.phi = (phil += phi) * U_SEC_TO_RAD; + *p++ = t; + } + } + if (feof(stdin)) { + fprintf(stderr, "premature EOF\n"); + exit(1); + } + if (!(bin = freopen(argv[1], "wb", stdout))) { + perror(argv[1]); + exit(2); + } + if (fwrite(&ct, sizeof(ct), 1, stdout) != 1 || + fwrite(ct.cvs, tsize, 1, stdout) != 1) { + fprintf(stderr, "output failure\n"); + exit(2); + } + exit(0); /* normal completion */ +} diff --git a/src/nad2nad.c b/src/nad2nad.c new file mode 100644 index 00000000..210854e6 --- /dev/null +++ b/src/nad2nad.c @@ -0,0 +1,313 @@ +/* <<<< North American Datum Transfer Program >>>> */ +#ifndef lint +static const char SCCSID[]="@(#)nad2nad.c 4.5 94/02/15 GIE REL"; +#endif +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> +#include <string.h> +#define PJ_LIST_H <nad_list.h> +#include <projects.h> +#include "emess.h" + +#define MAX_LINE 200 +#define MAX_PARGS 100 +#define PJ_INVERS(P) (P->inv ? 1 : 0) + static int +echoin = 0, /* echo input data to output line */ +tag = '#'; /* beginning of line tag character */ + static char +*oform = (char *)0, /* output format for x-y or decimal degrees */ +*oterr = "*\t*", /* output line for unprojectable input */ +*inargs = 0, +*outargs = 0, +*czone = 0, +*usage = +"%s\nusage: %s [ -eEfihortwW [args] ] [ files ]\n"; + struct CTABLE +*ctab = 0, +*htab = 0; +static struct TAG_LIST { + char *tag; + short sw; +} ops_list[] = { + "utm=", 0, + "spcs=", 1, + "feet", 2, + "27", 3, + "83", 4, + "hp", 5, + "bin", 6, + "rev", 7, + 0, 0, +}; +static struct IO_CON { + short rev; /* reverse lon/lat or x/y */ + short bin; /* io binary */ + short ll; /* io lat-lon */ + short t83; /* data in 83 datum */ + short zone; /* <100 utm zone, ==0 geog, else state plane zone */ + short nprojc; /* number of entries in projc */ + char *hp; /* high precision name */ + char *projc[10]; /* params for pj_init */ + PJ *cnv; +} input = { + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, +}, output = { + 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, +}; + static void +set_zone(int in, struct IO_CON *io) { + char tmp[20]; + + if (io->hp) { + io->t83 = 1; + if (!(htab = nad_init(io->hp))) + emess(1,"hp datum file: %s, failed: %s", io->hp, + pj_strerrno(pj_errno)); + } + if (io->zone > 0) { + if (io->zone <= 60) { /* UTM zone */ + io->nprojc = 2; /* no other options allowed */ + io->projc[0] = "proj=utm"; + sprintf(tmp, "zone=%d", io->zone); + io->projc[1] = io->t83 ? "ellps=GRS80" : "ellps=clrk66"; + } else /* SPCS zone */ + sprintf(tmp, "init=nad%s:%d", io->t83 ? "83" : "27", io->zone); + io->projc[io->nprojc++] = tmp; + io->projc[io->nprojc++] = "no_defs"; + if (!(io->cnv = pj_init(io->nprojc, io->projc))) + emess(1,pj_strerrno(pj_errno)); + io->ll = 0; + } +} + static void +setup() { + /* check and set zone operations */ + if (input.hp && output.hp) + emess(1,"both input and output cannot be high precision"); + set_zone(1, &input); + set_zone(0, &output); + if (input.cnv && !output.cnv) + output.ll = 1; + if (output.cnv && !input.cnv) + input.ll = 1; + if (!input.cnv && !output.cnv) + output.ll = input.ll = 1; + if (czone) { + if (!input.hp && !output.hp && input.t83 == output.t83) + emess(1,"identical datums"); + if (!(ctab = nad_init(czone))) + emess(1,"datum file: %s, failed: %s", czone, pj_strerrno(pj_errno)); + } else if (input.t83 != output.t83) + emess(1,"conversion region (-r) not specified"); +} + static void +set_ops(char *s, struct IO_CON *io) { + char *intag; + struct TAG_LIST *p; + + for ( ; intag = strtok(s, " ,\t"); s = 0) { + for (p = ops_list; p->tag; ++p) { + if (!strncmp(intag, p->tag, strlen(p->tag))) + break; + } + if (!p->tag) + emess(1,"invalid selection"); + switch (p->sw) { + case 0: + case 1: + s = strchr(intag, '=') + 1; + io->zone = atoi(s); + break; + case 2: + if (io->zone <= 60) + emess(1,"spcs zone must be selected"); + io->projc[io->nprojc++] = "units=us-ft"; + break; + case 3: io->t83 = 0; break; + case 4: io->t83 = 1; break; + case 5: + if (!(intag = strchr(intag, '=')) || *++intag == '\0') + emess(1,"hp missing name"); + strcpy(io->hp = malloc(strlen(intag)+1), intag); + break; + case 6: io->bin = 1; break; + case 7: io->rev = 1; break; + } + } +} + static void +process(FILE *fid) { + char line[MAX_LINE], *s, t, pline[100]; + UV val; + double tmp; + + for (;;) { + if (input.bin) + fread(&val, sizeof(UV), 1, fid); + else if (s = fgets(line, MAX_LINE, fid)) { + if (*s == tag) { + fputs(line, stdout); + continue; + } else if (input.ll) { + val.u = dmstor(s, &s); + val.v = dmstor(s, &s); + } else { + val.u = strtod(s, &s); + val.v = strtod(s, &s); + } + } + if (feof(fid)) + break; + if (input.rev) { + tmp = val.u; + val.u = val.v; + val.v = tmp; + } + /* data in, manupulate */ + if (input.cnv) + val = pj_inv(val, input.cnv); + if (input.hp) + val = nad_cvt(val, 1, htab); + /* nad conversion */ + if (ctab) + val = nad_cvt(val, input.t83 ? 1 : 0, ctab); + if (output.hp) + val = nad_cvt(val, 0, htab); + if (output.cnv) + val = pj_fwd(val, output.cnv); + /* output data */ + if (output.rev) { + tmp = val.u; + val.u = val.v; + val.v = tmp; + } + if (output.bin) + (void)fwrite(&val, sizeof(UV), 1, stdout); + else { + if (echoin) { + t = *s; + *s = '\0'; + (void)fputs(line, stdout); + (void)putchar('\t'); + *s = t; + } + if (val.u == HUGE_VAL) + (void)fputs(oterr, stdout); + else if (output.ll) + if (oform) { + (void)printf(oform, val.u * RAD_TO_DEG); + (void)putchar('\t'); + (void)printf(oform, val.v * RAD_TO_DEG); + } else if (output.rev) { + (void)fputs(rtodms(pline, val.u, 'N', 'S'), stdout); + (void)putchar('\t'); + (void)fputs(rtodms(pline, val.v, 'E', 'W'), stdout); + } else { + (void)fputs(rtodms(pline, val.u, 'E', 'W'), stdout); + (void)putchar('\t'); + (void)fputs(rtodms(pline, val.v, 'N', 'S'), stdout); + } + else { + (void)printf(oform ? oform : "%.2f", val.u); + (void)putchar('\t'); + (void)printf(oform ? oform : "%.2f", val.v); + } + if (input.bin) + putchar('\n'); + else + (void)fputs(s, stdout); + } + } +} + void +main(int argc, char **argv) { + char *arg, **eargv = argv, work[MAX_PARGS]; + FILE *fid; + int eargc = 0, c; + + if (emess_dat.Prog_name = strrchr(*argv,DIR_CHAR)) + ++emess_dat.Prog_name; + else emess_dat.Prog_name = *argv; + if (argc <= 1 ) { + (void)fprintf(stderr, usage, pj_release, emess_dat.Prog_name); + exit (0); + } + /* process run line arguments */ + while (--argc > 0) { /* collect run line arguments */ + if(**++argv == '-') for(arg = *argv;;) { + switch(*++arg) { + case '\0': /* position of "stdin" */ + if (arg[-1] == '-') eargv[eargc++] = "-"; + break; + case 'i': /* input control */ + case 'o': /* output control */ + if (--argc <= 0) goto noargument; + strncpy(work, *++argv, MAX_PARGS); + set_ops(work, *arg == 'i' ? &input : &output); + continue; + case 'r': /* nad27/83 conversion zone */ + if (--argc <= 0) goto noargument; + czone = *++argv; + continue; + case 'E': /* echo ascii input to ascii output */ + echoin = 1; + continue; + case 't': /* set col. one char */ + if (arg[1]) tag = *++arg; + else emess(1,"missing -t col. 1 tag"); + continue; + case 'W': /* specify seconds precision */ + case 'w': /* -W for constant field width */ + if ((c = arg[1]) != 0 && isdigit(c)) { + set_rtodms(c - '0', *arg == 'W'); + ++arg; + } else + emess(1,"-W argument missing or non-digit"); + continue; + case 'f': /* alternate output format degrees or xy */ + if (--argc <= 0) goto noargument; + oform = *++argv; + continue; + case 'e': /* error line alternative */ + if (--argc <= 0) +noargument: emess(1,"missing argument for -%c",*arg); + oterr = *++argv; + continue; + default: + emess(1, "invalid option: -%c",*arg); + break; + } + break; + } else /* assumed to be input file name(s) */ + eargv[eargc++] = *argv; + } + if (eargc == 0) /* if no specific files force sysin */ + eargv[eargc++] = "-"; + /* done with parameter and control input */ + setup(); + /* process input file list */ + for ( ; eargc-- ; ++eargv) { + if (**eargv == '-') { + fid = stdin; + emess_dat.File_name = "<stdin>"; + } else { + if ((fid = fopen(*eargv, "r")) == NULL) { + emess(-2, *eargv, "input file"); + continue; + } + emess_dat.File_name = *eargv; + } + emess_dat.File_line = 0; + /* process file */ + process(fid); + (void)fclose(fid); + emess_dat.File_name = 0; + } + exit(0); /* normal completion */ +} diff --git a/src/nad_cvt.c b/src/nad_cvt.c new file mode 100644 index 00000000..600ea3cd --- /dev/null +++ b/src/nad_cvt.c @@ -0,0 +1,49 @@ +#ifndef lint +static const char SCCSID[]="@(#)nad_cvt.c 4.3 95/09/23 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#define MAX_TRY 9 +#define TOL 1e-12 + LP +nad_cvt(LP in, int inverse, struct CTABLE *ct) { + LP t, tb; + + if (in.lam == HUGE_VAL) + return in; + /* normalize input to ll origin */ + tb = in; + tb.lam -= ct->ll.lam; + tb.phi -= ct->ll.phi; + tb.lam = adjlon(tb.lam); + t = nad_intr(tb, ct); + if (inverse) { + LP del, dif; + int i = MAX_TRY; + + if (t.lam == HUGE_VAL) return t; + t.lam = tb.lam + t.lam; + t.phi = tb.phi - t.phi; + + do { + del = nad_intr(t, ct); + if (del.lam == HUGE_VAL) return del; + t.lam -= dif.lam = t.lam - del.lam - tb.lam; + t.phi -= dif.phi = t.phi + del.phi - tb.phi; + } while (i-- && fabs(dif.lam) > TOL && fabs(dif.phi) > TOL); + if (i < 0) { + t.lam = t.phi = HUGE_VAL; + return t; + } + in.lam = adjlon(t.lam + ct->ll.lam); + in.phi = t.phi + ct->ll.phi; + } else { + if (t.lam == HUGE_VAL) + in = t; + else { + in.lam -= t.lam; + in.phi += t.phi; + } + } + return in; +} diff --git a/src/nad_init.c b/src/nad_init.c new file mode 100644 index 00000000..ed3b6273 --- /dev/null +++ b/src/nad_init.c @@ -0,0 +1,43 @@ +/* open structure for NAD27<->NAD83 conversion */ +#ifndef lint +static const char SCCSID[]="@(#)nad_init.c 4.5 94/10/30 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <stdio.h> +#include <errno.h> +extern FILE *pj_open_lib(char *, char *); + struct CTABLE * +nad_init(char *name) { + char fname[MAX_PATH_FILENAME+1]; + struct CTABLE *ct; + FILE *fid; + size_t i; + + errno = pj_errno = 0; + strcpy(fname, "nad2783/"); + strcat(fname, name); + if (!(fid = pj_open_lib(fname, "rb"))) { + pj_errno = errno; + return 0; + } + if (!(ct = pj_malloc(sizeof(struct CTABLE))) || + fread(ct, sizeof(struct CTABLE), 1, fid) != 1 || + !(ct->cvs = (FLP *)pj_malloc(i=sizeof(FLP)*ct->lim.lam*ct->lim.phi)) || + fread(ct->cvs, i, 1, fid) != 1) { + nad_free(ct); + pj_errno = -38; + ct = 0; + return 0; + } + fclose(fid); + pj_errno = 0; + return ct; +} + void +nad_free(struct CTABLE *ct) { + if (ct) { + pj_dalloc(ct->cvs); + pj_dalloc(ct); + } +} diff --git a/src/nad_intr.c b/src/nad_intr.c new file mode 100644 index 00000000..8bf24419 --- /dev/null +++ b/src/nad_intr.c @@ -0,0 +1,65 @@ +/* Determine nad table correction value */ +#ifndef lint +static const char SCCSID[]="@(#)nad_intr.c 4.2 95/09/23 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> + LP +nad_intr(LP t, struct CTABLE *ct) { + LP val, frct; + ILP indx; + double m00, m10, m01, m11; + FLP *f00, *f10, *f01, *f11; + long index; + int in; + + indx.lam = floor(t.lam /= ct->del.lam); + indx.phi = floor(t.phi /= ct->del.phi); + frct.lam = t.lam - indx.lam; + frct.phi = t.phi - indx.phi; + val.lam = val.phi = HUGE_VAL; + if (indx.lam < 0) { + if (indx.lam == -1 && frct.lam > 0.99999999999) { + ++indx.lam; + frct.lam = 0.; + } else + return val; + } else if ((in = indx.lam + 1) >= ct->lim.lam) { + if (in == ct->lim.lam && frct.lam < 1e-11) { + --indx.lam; + frct.lam = 1.; + } else + return val; + } + if (indx.phi < 0) { + if (indx.phi == -1 && frct.phi > 0.99999999999) { + ++indx.phi; + frct.phi = 0.; + } else + return val; + } else if ((in = indx.phi + 1) >= ct->lim.phi) { + if (in == ct->lim.phi && frct.phi < 1e-11) { + --indx.phi; + frct.phi = 1.; + } else + return val; + } + index = indx.phi * ct->lim.lam + indx.lam; + f00 = ct->cvs + index++; + f10 = ct->cvs + index; + index += ct->lim.lam; + f11 = ct->cvs + index--; + f01 = ct->cvs + index; + m11 = m10 = frct.lam; + m00 = m01 = 1. - frct.lam; + m11 *= frct.phi; + m01 *= frct.phi; + frct.phi = 1. - frct.phi; + m00 *= frct.phi; + m10 *= frct.phi; + val.lam = m00 * f00->lam + m10 * f10->lam + + m01 * f01->lam + m11 * f11->lam; + val.phi = m00 * f00->phi + m10 * f10->phi + + m01 * f01->phi + m11 * f11->phi; + return val; +} diff --git a/src/nad_list.h b/src/nad_list.h new file mode 100644 index 00000000..f82a2ab7 --- /dev/null +++ b/src/nad_list.h @@ -0,0 +1,6 @@ +/* projection list for program nad2nad */ +PROJ_HEAD(lcc, "Lambert Conformal Conic") +PROJ_HEAD(omerc, "Oblique Mercator") +PROJ_HEAD(poly, "Polyconic (American)") +PROJ_HEAD(tmerc, "Transverse Mercator") +PROJ_HEAD(utm, "Universal Transverse Mercator (UTM)") diff --git a/src/p_series.c b/src/p_series.c new file mode 100644 index 00000000..7c16a23d --- /dev/null +++ b/src/p_series.c @@ -0,0 +1,42 @@ +/* print row coefficients of Tseries structure */ +#ifndef lint +static const char SCCSID[]="@(#)p_series.c 4.6 95/08/19 GIE REL"; +#endif +#include <stdio.h> +#include <string.h> +#include <projects.h> +#define NF 20 /* length of final format string */ +#define CUT 60 /* check length of line */ + void +p_series(Tseries *T, FILE *file, char *fmt) { + int i, j, n, L; + char format[NF+1]; + + *format = ' '; + strncpy(format + 1, fmt, NF - 3); + strcat(format, "%n"); + fprintf(file, "u: %d\n", T->mu+1); + for (i = 0; i <= T->mu; ++i) + if (T->cu[i].m) { + fprintf(file, "%d %d%n", i, T->cu[i].m, &L); + n = 0; + for (j = 0; j < T->cu[i].m; ++j) { + if ((L += n) > CUT) + fprintf(file, "\n %n", &L); + fprintf(file, format, T->cu[i].c[j], &n); + } + fputc('\n', file); + } + fprintf(file, "v: %d\n", T->mv+1); + for (i = 0; i <= T->mv; ++i) + if (T->cv[i].m) { + fprintf(file, "%d %d%n", i, T->cv[i].m, &L); + n = 0; + for (j = 0; j < T->cv[i].m; ++j) { + if ((L += n) > 60) + fprintf(file, "\n %n", &L); + fprintf(file, format, T->cv[i].c[j], &n); + } + fputc('\n', file); + } +} diff --git a/src/pj_auth.c b/src/pj_auth.c new file mode 100644 index 00000000..92ec339b --- /dev/null +++ b/src/pj_auth.c @@ -0,0 +1,33 @@ +/* determine latitude from authalic latitude */ +#ifndef lint +static const char SCCSID[]="@(#)pj_auth.c 4.3 93/06/12 GIE REL"; +#endif +#include <projects.h> +# define P00 .33333333333333333333 +# define P01 .17222222222222222222 +# define P02 .10257936507936507936 +# define P10 .06388888888888888888 +# define P11 .06640211640211640211 +# define P20 .01641501294219154443 +#define APA_SIZE 3 + double * +pj_authset(double es) { + double t, *APA; + + if (APA = (double *)pj_malloc(APA_SIZE * sizeof(double))) { + APA[0] = es * P00; + t = es * es; + APA[0] += t * P01; + APA[1] = t * P10; + t *= es; + APA[0] += t * P02; + APA[1] += t * P11; + APA[2] = t * P20; + } + return APA; +} + double +pj_authlat(double beta, double *APA) { + double t = beta+beta; + return(beta + APA[0] * sin(t) + APA[1] * sin(t+t) + APA[2] * sin(t+t+t)); +} diff --git a/src/pj_deriv.c b/src/pj_deriv.c new file mode 100644 index 00000000..f6477b08 --- /dev/null +++ b/src/pj_deriv.c @@ -0,0 +1,36 @@ +/* dervative of (*P->fwd) projection */ +#ifndef lint +static const char SCCSID[]="@(#)pj_deriv.c 4.4 93/06/12 GIE REL"; +#endif +#define PJ_LIB__ +#include "projects.h" + int +pj_deriv(LP lp, double h, PJ *P, struct DERIVS *der) { + XY t; + + lp.lam += h; + lp.phi += h; + if (fabs(lp.phi) > HALFPI) return 1; + h += h; + t = (*P->fwd)(lp, P); + if (t.x == HUGE_VAL) return 1; + der->x_l = t.x; der->y_p = t.y; der->x_p = -t.x; der->y_l = -t.y; + lp.phi -= h; + if (fabs(lp.phi) > HALFPI) return 1; + t = (*P->fwd)(lp, P); + if (t.x == HUGE_VAL) return 1; + der->x_l += t.x; der->y_p -= t.y; der->x_p += t.x; der->y_l -= t.y; + lp.lam -= h; + t = (*P->fwd)(lp, P); + if (t.x == HUGE_VAL) return 1; + der->x_l -= t.x; der->y_p -= t.y; der->x_p += t.x; der->y_l += t.y; + lp.phi += h; + t = (*P->fwd)(lp, P); + if (t.x == HUGE_VAL) return 1; + der->x_l -= t.x; der->y_p += t.y; der->x_p -= t.x; der->y_l += t.y; + der->x_l /= (h += h); + der->y_p /= h; + der->x_p /= h; + der->y_l /= h; + return 0; +} diff --git a/src/pj_ell_set.c b/src/pj_ell_set.c new file mode 100644 index 00000000..7d220331 --- /dev/null +++ b/src/pj_ell_set.c @@ -0,0 +1,105 @@ +/* set ellipsoid parameters a and es */ +#ifndef lint +static const char SCCSID[]="@(#)pj_ell_set.c 4.5 93/06/12 GIE REL"; +#endif +#include <projects.h> +#include <string.h> +#define SIXTH .1666666666666666667 /* 1/6 */ +#define RA4 .04722222222222222222 /* 17/360 */ +#define RA6 .02215608465608465608 /* 67/3024 */ +#define RV4 .06944444444444444444 /* 5/72 */ +#define RV6 .04243827160493827160 /* 55/1296 */ + int /* initialize geographic shape parameters */ +pj_ell_set(paralist *pl, double *a, double *es) { + int i; + double b, e; + char *name; + paralist *start = 0, *curr; + + /* check for varying forms of ellipsoid input */ + *a = *es = 0.; + /* R takes precedence */ + if (pj_param(pl, "tR").i) + *a = pj_param(pl, "dR").f; + else { /* probable elliptical figure */ + + /* check if ellps present and temporarily append its values to pl */ + if (name = pj_param(pl, "sellps").s) { + char *s; + + for (start = pl; start && start->next ; start = start->next) ; + curr = start; + for (i = 0; (s = pj_ellps[i].id) && strcmp(name, s) ; ++i) ; + if (!s) { pj_errno = -9; return 1; } + curr = curr->next = pj_mkparam(pj_ellps[i].major); + curr = curr->next = pj_mkparam(pj_ellps[i].ell); + } + *a = pj_param(pl, "da").f; + if (pj_param(pl, "tes").i) /* eccentricity squared */ + *es = pj_param(pl, "des").f; + else if (pj_param(pl, "te").i) { /* eccentricity */ + e = pj_param(pl, "de").f; + *es = e * e; + } else if (pj_param(pl, "trf").i) { /* recip flattening */ + *es = pj_param(pl, "drf").f; + if (!*es) { + pj_errno = -10; + goto bomb; + } + *es = 1./ *es; + *es = *es * (2. - *es); + } else if (pj_param(pl, "tf").i) { /* flattening */ + *es = pj_param(pl, "df").f; + *es = *es * (2. - *es); + } else if (pj_param(pl, "tb").i) { /* minor axis */ + b = pj_param(pl, "db").f; + *es = 1. - (b * b) / (*a * *a); + } /* else *es == 0. and sphere of radius *a */ + if (!b) + b = *a * sqrt(1. - *es); + /* following options turn ellipsoid into equivalent sphere */ + if (pj_param(pl, "bR_A").i) { /* sphere--area of ellipsoid */ + *a *= 1. - *es * (SIXTH + *es * (RA4 + *es * RA6)); + *es = 0.; + } else if (pj_param(pl, "bR_V").i) { /* sphere--vol. of ellipsoid */ + *a *= 1. - *es * (SIXTH + *es * (RV4 + *es * RV6)); + *es = 0.; + } else if (pj_param(pl, "bR_a").i) { /* sphere--arithmetic mean */ + *a = .5 * (*a + b); + *es = 0.; + } else if (pj_param(pl, "bR_g").i) { /* sphere--geometric mean */ + *a = sqrt(*a * b); + *es = 0.; + } else if (pj_param(pl, "bR_h").i) { /* sphere--harmonic mean */ + *a = 2. * *a * b / (*a + b); + *es = 0.; + } else if ((i = pj_param(pl, "tR_lat_a").i) || /* sphere--arith. */ + pj_param(pl, "tR_lat_g").i) { /* or geom. mean at latitude */ + double tmp; + + tmp = sin(pj_param(pl, i ? "rR_lat_a" : "rR_lat_g").f); + if (fabs(tmp) > HALFPI) { + pj_errno = -11; + goto bomb; + } + tmp = 1. - *es * tmp * tmp; + *a *= i ? .5 * (1. - *es + tmp) / ( tmp * sqrt(tmp)) : + sqrt(1. - *es) / tmp; + *es = 0.; + } +bomb: + if (start) { /* clean up temporary extension of list */ + pj_dalloc(start->next->next); + pj_dalloc(start->next); + start->next = 0; + } + if (pj_errno) + return 1; + } + /* some remaining checks */ + if (*es < 0.) + { pj_errno = -12; return 1; } + if (*a <= 0.) + { pj_errno = -13; return 1; } + return 0; +} diff --git a/src/pj_ellps.c b/src/pj_ellps.c new file mode 100644 index 00000000..c26a9007 --- /dev/null +++ b/src/pj_ellps.c @@ -0,0 +1,51 @@ +/* definition of standard geoids */ +#ifndef lint +static const char SCCSID[]="@(#)pj_ellps.c 4.6 95/08/25 GIE REL"; +#endif +#define PJ_ELLPS__ +#include "projects.h" + struct PJ_ELLPS +pj_ellps[] = { +"MERIT", "a=6378137.0", "rf=298.257", "MERIT 1983", +"SGS85", "a=6378136.0", "rf=298.257", "Soviet Geodetic System 85", +"GRS80", "a=6378137.0", "rf=298.257222101", "GRS 1980(IUGG, 1980)", +"IAU76", "a=6378140.0", "rf=298.257", "IAU 1976", +"airy", "a=6377563.396", "b=6356256.910", "Airy 1830", +"APL4.9", "a=6378137.0.", "rf=298.25", "Appl. Physics. 1965", +"NWL9D", "a=6378145.0.", "rf=298.25", "Naval Weapons Lab., 1965", +"mod_airy", "a=6377340.189", "b=6356034.446", "Modified Airy", +"andrae", "a=6377104.43", "rf=300.0", "Andrae 1876 (Den., Iclnd.)", +"aust_SA", "a=6378160.0", "rf=298.25", "Australian Natl & S. Amer. 1969", +"GRS67", "a=6378160.0", "rf=298.2471674270", "GRS 67(IUGG 1967)", +"bessel", "a=6377397.155", "rf=299.1528128", "Bessel 1841", +"bess_nam", "a=6377483.865", "rf=299.1528128", "Bessel 1841 (Namibia)", +"clrk66", "a=6378206.4", "b=6356583.8", "Clarke 1866", +"clrk80", "a=6378249.145", "rf=293.4663", "Clarke 1880 mod.", +"CPM", "a=6375738.7", "rf=334.29", "Comm. des Poids et Mesures 1799", +"delmbr", "a=6376428.", "rf=311.5", "Delambre 1810 (Belgium)", +"engelis", "a=6378136.05", "rf=298.2566", "Engelis 1985", +"evrst30", "a=6377276.345", "rf=300.8017", "Everest 1830", +"evrst48", "a=6377304.063", "rf=300.8017", "Everest 1948", +"evrst56", "a=6377301.243", "rf=300.8017", "Everest 1956", +"evrst69", "a=6377295.664", "rf=300.8017", "Everest 1969", +"evrstSS", "a=6377298.556", "rf=300.8017", "Everest (Sabah & Sarawak)", +"fschr60", "a=6378166.", "rf=298.3", "Fischer (Mercury Datum) 1960", +"fschr60m", "a=6378155.", "rf=298.3", "Modified Fischer 1960", +"fschr68", "a=6378150.", "rf=298.3", "Fischer 1968", +"helmert", "a=6378200.", "rf=298.3", "Helmert 1906", +"hough", "a=6378270.0", "rf=297.", "Hough", +"intl", "a=6378388.0", "rf=297.", "International 1909 (Hayford)", +"krass", "a=6378245.0", "rf=298.3", "Krassovsky, 1942", +"kaula", "a=6378163.", "rf=298.24", "Kaula 1961", +"lerch", "a=6378139.", "rf=298.257", "Lerch 1979", +"mprts", "a=6397300.", "rf=191.", "Maupertius 1738", +"new_intl", "a=6378157.5", "b=6356772.2", "New International 1967", +"plessis", "a=6376523.", "b=6355863.", "Plessis 1817 (France)", +"SEasia", "a=6378155.0", "b=6356773.3205", "Southeast Asia", +"walbeck", "a=6376896.0", "b=6355834.8467", "Walbeck", +"WGS60", "a=6378165.0", "rf=298.3", "WGS 60", +"WGS66", "a=6378145.0", "rf=298.25", "WGS 66", +"WGS72", "a=6378135.0", "rf=298.26", "WGS 72", +"WGS84", "a=6378137.0", "rf=298.257223563", "WGS 84", +0,0,0,0 +}; diff --git a/src/pj_errno.c b/src/pj_errno.c new file mode 100644 index 00000000..4156d7e5 --- /dev/null +++ b/src/pj_errno.c @@ -0,0 +1,8 @@ +/* For full ANSI compliance of global variable */ +#ifndef lint +static const char SCCSID[]="@(#)pj_errno.c 4.3 95/06/03 GIE REL"; +#endif + +int pj_errno = 0; + +/* end */ diff --git a/src/pj_factors.c b/src/pj_factors.c new file mode 100644 index 00000000..32021b89 --- /dev/null +++ b/src/pj_factors.c @@ -0,0 +1,86 @@ +/* projection scale factors */ +#ifndef lint +static const char SCCSID[]="@(#)pj_factors.c 4.9 94/03/17 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <errno.h> +#ifndef DEFAULT_H +#define DEFAULT_H 1e-5 /* radian default for numeric h */ +#endif +#define EPS 1.0e-12 + int +pj_factors(LP lp, PJ *P, double h, struct FACTORS *fac) { + struct DERIVS der; + double cosphi, t, n, r; + + /* check for forward and latitude or longitude overange */ + if ((t = fabs(lp.phi)-HALFPI) > EPS || fabs(lp.lam) > 10.) { + pj_errno = -14; + return 1; + } else { /* proceed */ + errno = pj_errno = 0; + if (fabs(t) <= EPS) /* adjust to pi/2 */ + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + else if (P->geoc) + lp.phi = atan(P->rone_es * tan(lp.phi)); + lp.lam -= P->lam0; /* compute del lp.lam */ + if (!P->over) + lp.lam = adjlon(lp.lam); /* adjust del longitude */ + if (h <= 0.) + h = DEFAULT_H; + if (P->spc) /* get what projection analytic values */ + P->spc(lp, P, fac); + if (((fac->code & (IS_ANAL_XL_YL+IS_ANAL_XP_YP)) != + (IS_ANAL_XL_YL+IS_ANAL_XP_YP)) && + pj_deriv(lp, h, P, &der)) + return 1; + if (!(fac->code & IS_ANAL_XL_YL)) { + fac->der.x_l = der.x_l; + fac->der.y_l = der.y_l; + } + if (!(fac->code & IS_ANAL_XP_YP)) { + fac->der.x_p = der.x_p; + fac->der.y_p = der.y_p; + } + cosphi = cos(lp.phi); + if (!(fac->code & IS_ANAL_HK)) { + fac->h = hypot(fac->der.x_p, fac->der.y_p); + fac->k = hypot(fac->der.x_l, fac->der.y_l) / cosphi; + if (P->es) { + t = sin(lp.phi); + t = 1. - P->es * t * t; + n = sqrt(t); + fac->h *= t * n / P->one_es; + fac->k *= n; + r = t * t / P->one_es; + } else + r = 1.; + } else if (P->es) { + r = sin(lp.phi); + r = 1. - P->es * r * r; + r = r * r / P->one_es; + } else + r = 1.; + /* convergence */ + if (!(fac->code & IS_ANAL_CONV)) { + fac->conv = - atan2(fac->der.y_l, fac->der.x_l); + if (fac->code & IS_ANAL_XL_YL) + fac->code |= IS_ANAL_CONV; + } + /* areal scale factor */ + fac->s = (fac->der.y_p * fac->der.x_l - fac->der.x_p * fac->der.y_l) * + r / cosphi; + /* meridian-parallel angle theta prime */ + fac->thetap = aasin(fac->s / (fac->h * fac->k)); + /* Tissot ellips axis */ + t = fac->k * fac->k + fac->h * fac->h; + fac->a = sqrt(t + 2. * fac->s); + t = (t = t - 2. * fac->s) <= 0. ? 0. : sqrt(t); + fac->b = 0.5 * (fac->a - t); + fac->a = 0.5 * (fac->a + t); + /* omega */ + fac->omega = 2. * aasin((fac->a - fac->b)/(fac->a + fac->b)); + } + return 0; +} diff --git a/src/pj_fwd.c b/src/pj_fwd.c new file mode 100644 index 00000000..e88472af --- /dev/null +++ b/src/pj_fwd.c @@ -0,0 +1,37 @@ +/* general forward projection */ +#ifndef lint +static const char SCCSID[]="@(#)pj_fwd.c 4.4 93/06/12 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <errno.h> +# define EPS 1.0e-12 + XY /* forward projection entry */ +pj_fwd(LP lp, PJ *P) { + XY xy; + double t; + + /* check for forward and latitude or longitude overange */ + if ((t = fabs(lp.phi)-HALFPI) > EPS || fabs(lp.lam) > 10.) { + xy.x = xy.y = HUGE_VAL; + pj_errno = -14; + } else { /* proceed with projection */ + errno = pj_errno = 0; + if (fabs(t) <= EPS) + lp.phi = lp.phi < 0. ? -HALFPI : HALFPI; + else if (P->geoc) + lp.phi = atan(P->rone_es * tan(lp.phi)); + lp.lam -= P->lam0; /* compute del lp.lam */ + if (!P->over) + lp.lam = adjlon(lp.lam); /* adjust del longitude */ + xy = (*P->fwd)(lp, P); /* project */ + if (pj_errno || (pj_errno = errno)) + xy.x = xy.y = HUGE_VAL; + /* adjust for major axis and easting/northings */ + else { + xy.x = P->fr_meter * (P->a * xy.x + P->x0); + xy.y = P->fr_meter * (P->a * xy.y + P->y0); + } + } + return xy; +} diff --git a/src/pj_init.c b/src/pj_init.c new file mode 100644 index 00000000..68b77c9c --- /dev/null +++ b/src/pj_init.c @@ -0,0 +1,176 @@ +/* projection initialization and closure */ +#ifndef lint +static const char SCCSID[]="@(#)pj_init.c 4.13 95/09/05 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <stdio.h> +#include <string.h> +#include <errno.h> + static paralist +*start; +extern FILE *pj_open_lib(char *, char *); + static paralist * +get_opt(FILE *fid, char *name, paralist *next) { + char sword[52], *word = sword+1; + int first = 1, len, c; + + len = strlen(name); + *sword = 't'; + while (fscanf(fid, "%50s", word) == 1) + if (*word == '#') /* skip comments */ + while((c = fgetc(fid)) != EOF && c != '\n') ; + else if (*word == '<') { /* control name */ + if (first && !strncmp(name, word + 1, len) + && word[len + 1] == '>') + first = 0; + else if (!first && word[1] == '>') + break; + } else if (!first && !pj_param(start, sword).i) + next = next->next = pj_mkparam(word); + if (errno == 25) + errno = 0; + return next; +} + static paralist * +get_defaults(paralist *next, char *name) { + FILE *fid; + + if (fid = pj_open_lib("proj_def.dat", "r")) { + next = get_opt(fid, "general", next); + rewind(fid); + next = get_opt(fid, name, next); + (void)fclose(fid); + } + if (errno) + errno = 0; /* don't care if can't open file */ + return next; +} + static paralist * +get_init(paralist *next, char *name) { + char fname[MAX_PATH_FILENAME+ID_TAG_MAX+3], *opt; + FILE *fid; + + (void)strncpy(fname, name, MAX_PATH_FILENAME + ID_TAG_MAX + 1); + if (opt = strrchr(fname, ':')) + *opt++ = '\0'; + else { pj_errno = -3; return(0); } + if (fid = pj_open_lib(fname, "r")) + next = get_opt(fid, opt, next); + else + return(0); + (void)fclose(fid); + if (errno == 25) + errno = 0; /* unknown problem with some sys errno<-25 */ + return next; +} + PJ * +pj_init(int argc, char **argv) { + char *s, *name; + void *(*proj)(PJ *); + paralist *curr; + int i; + PJ *PIN = 0; + + errno = pj_errno = 0; + /* put arguments into internal linked list */ + if (argc <= 0) { pj_errno = -1; goto bum_call; } + for (i = 0; i < argc; ++i) + if (i) + curr = curr->next = pj_mkparam(argv[i]); + else + start = curr = pj_mkparam(argv[i]); + if (pj_errno) goto bum_call; + /* check if +init present */ + if (pj_param(start, "tinit").i) { + paralist *last = curr; + + if (!(curr = get_init(curr, pj_param(start, "sinit").s))) + goto bum_call; + if (curr == last) { pj_errno = -2; goto bum_call; } + } + /* find projection selection */ + if (!(name = pj_param(start, "sproj").s)) + { pj_errno = -4; goto bum_call; } + for (i = 0; (s = pj_list[i].id) && strcmp(name, s) ; ++i) ; + if (!s) { pj_errno = -5; goto bum_call; } + /* set defaults, unless inhibited */ + if (!pj_param(start, "bno_defs").i) + curr = get_defaults(curr, name); + proj = pj_list[i].proj; + /* allocate projection structure */ + if (!(PIN = (*proj)(0))) goto bum_call; + PIN->params = start; + /* set ellipsoid/sphere parameters */ + if (pj_ell_set(start, &PIN->a, &PIN->es)) goto bum_call; + PIN->e = sqrt(PIN->es); + PIN->ra = 1. / PIN->a; + PIN->one_es = 1. - PIN->es; + if (PIN->one_es == 0.) { pj_errno = -6; goto bum_call; } + PIN->rone_es = 1./PIN->one_es; + /* set PIN->geoc coordinate system */ + PIN->geoc = (PIN->es && pj_param(start, "bgeoc").i); + /* over-ranging flag */ + PIN->over = pj_param(start, "bover").i; + /* central meridian */ + PIN->lam0=pj_param(start, "rlon_0").f; + /* central latitude */ + PIN->phi0 = pj_param(start, "rlat_0").f; + /* false easting and northing */ + PIN->x0 = pj_param(start, "dx_0").f; + PIN->y0 = pj_param(start, "dy_0").f; + /* general scaling factor */ + if (pj_param(start, "tk_0").i) + PIN->k0 = pj_param(start, "dk_0").f; + else if (pj_param(start, "tk").i) + PIN->k0 = pj_param(start, "dk").f; + else + PIN->k0 = 1.; + if (PIN->k0 <= 0.) { + pj_errno = -31; + goto bum_call; + } + /* set units */ + s = 0; + if (name = pj_param(start, "sunits").s) { + for (i = 0; (s = pj_units[i].id) && strcmp(name, s) ; ++i) ; + if (!s) { pj_errno = -7; goto bum_call; } + s = pj_units[i].to_meter; + } + if (s || (s = pj_param(start, "sto_meter").s)) { + PIN->to_meter = strtod(s, &s); + if (*s == '/') /* ratio number */ + PIN->to_meter /= strtod(++s, 0); + PIN->fr_meter = 1. / PIN->to_meter; + } else + PIN->to_meter = PIN->fr_meter = 1.; + /* projection specific initialization */ + if (!(PIN = (*proj)(PIN)) || errno || pj_errno) { +bum_call: /* cleanup error return */ + if (!pj_errno) + pj_errno = errno; + if (PIN) + pj_free(PIN); + else + for ( ; start; start = curr) { + curr = start->next; + pj_dalloc(start); + } + PIN = 0; + } + return PIN; +} + void +pj_free(PJ *P) { + if (P) { + paralist *t = P->params, *n; + + /* free parameter list elements */ + for (t = P->params; t; t = n) { + n = t->next; + pj_dalloc(t); + } + /* free projection parameters */ + P->pfree(P); + } +} diff --git a/src/pj_inv.c b/src/pj_inv.c new file mode 100644 index 00000000..16dd90dd --- /dev/null +++ b/src/pj_inv.c @@ -0,0 +1,32 @@ +/* general inverse projection */ +#ifndef lint +static const char SCCSID[]="@(#)pj_inv.c 4.5 93/06/12 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <errno.h> +# define EPS 1.0e-12 + LP /* inverse projection entry */ +pj_inv(XY xy, PJ *P) { + LP lp; + + /* can't do as much preliminary checking as with forward */ + if (xy.x == HUGE_VAL || xy.y == HUGE_VAL) { + lp.lam = lp.phi = HUGE_VAL; + pj_errno = -15; + } + errno = pj_errno = 0; + xy.x = (xy.x * P->to_meter - P->x0) * P->ra; /* descale and de-offset */ + xy.y = (xy.y * P->to_meter - P->y0) * P->ra; + lp = (*P->inv)(xy, P); /* inverse project */ + if (pj_errno || (pj_errno = errno)) + lp.lam = lp.phi = HUGE_VAL; + else { + lp.lam += P->lam0; /* reduce from del lp.lam */ + if (!P->over) + lp.lam = adjlon(lp.lam); /* adjust longitude to CM */ + if (P->geoc && fabs(fabs(lp.phi)-HALFPI) > EPS) + lp.phi = atan(P->one_es * tan(lp.phi)); + } + return lp; +} diff --git a/src/pj_list.c b/src/pj_list.c new file mode 100644 index 00000000..79a6ca02 --- /dev/null +++ b/src/pj_list.c @@ -0,0 +1,8 @@ +#ifndef lint +static const char SCCSID[]="@(#)pj_list.c 4.6 94/02/15 GIE REL"; +#endif +/* Projection System: default list of projections +** Use local definition of PJ_LIST_H for subset. +*/ +#define PJ_LIST_H "pj_list.h" +#include "projects.h" diff --git a/src/pj_list.h b/src/pj_list.h new file mode 100644 index 00000000..3a1c300d --- /dev/null +++ b/src/pj_list.h @@ -0,0 +1,126 @@ +#ifdef DO_PJ_LIST_ID +static const char PJ_LIST_H_ID[] = "@(#)pj_list.h 4.5 95/08/09 GIE REL"; +#endif +/* Full list of current projections for Tue Jan 11 12:27:04 EST 1994 +** +** Copy this file and retain only appropriate lines for subset list +*/ +PROJ_HEAD(aea, "Albers Equal Area") +PROJ_HEAD(aeqd, "Azimuthal Equidistant") +PROJ_HEAD(airy, "Airy") +PROJ_HEAD(aitoff, "Aitoff") +PROJ_HEAD(alsk, "Mod. Stererographics of Alaska") +PROJ_HEAD(apian, "Apian Globular I") +PROJ_HEAD(august, "August Epicycloidal") +PROJ_HEAD(bacon, "Bacon Globular") +PROJ_HEAD(bipc, "Bipolar conic of western hemisphere") +PROJ_HEAD(boggs, "Boggs Eumorphic") +PROJ_HEAD(bonne, "Bonne (Werner lat_1=90)") +PROJ_HEAD(cass, "Cassini") +PROJ_HEAD(cc, "Central Cylindrical") +PROJ_HEAD(cea, "Equal Area Cylindrical") +PROJ_HEAD(chamb, "Chamberlin Trimetric") +PROJ_HEAD(collg, "Collignon") +PROJ_HEAD(crast, "Craster Parabolic (Putnins P4)") +PROJ_HEAD(denoy, "Denoyer Semi-Elliptical") +PROJ_HEAD(eck1, "Eckert I") +PROJ_HEAD(eck2, "Eckert II") +PROJ_HEAD(eck3, "Eckert III") +PROJ_HEAD(eck4, "Eckert IV") +PROJ_HEAD(eck5, "Eckert V") +PROJ_HEAD(eck6, "Eckert VI") +PROJ_HEAD(eqc, "Equidistant Cylindrical (Plate Caree)") +PROJ_HEAD(eqdc, "Equidistant Conic") +PROJ_HEAD(euler, "Euler") +PROJ_HEAD(fahey, "Fahey") +PROJ_HEAD(fouc, "Foucaut") +PROJ_HEAD(fouc_s, "Foucaut Sinusoidal") +PROJ_HEAD(gall, "Gall (Gall Stereographic)") +PROJ_HEAD(gins8, "Ginsburg VIII (TsNIIGAiK)") +PROJ_HEAD(gn_sinu, "General Sinusoidal Series") +PROJ_HEAD(gnom, "Gnomonic") +PROJ_HEAD(goode, "Goode Homolosine") +PROJ_HEAD(gs48, "Mod. Stererographics of 48 U.S.") +PROJ_HEAD(gs50, "Mod. Stererographics of 50 U.S.") +PROJ_HEAD(hammer, "Hammer & Eckert-Greifendorff") +PROJ_HEAD(hatano, "Hatano Asymmetrical Equal Area") +PROJ_HEAD(imw_p, "Internation Map of the World Polyconic") +PROJ_HEAD(kav5, "Kavraisky V") +PROJ_HEAD(kav7, "Kavraisky VII") +PROJ_HEAD(labrd, "Laborde") +PROJ_HEAD(laea, "Lambert Azimuthal Equal Area") +PROJ_HEAD(lagrng, "Lagrange") +PROJ_HEAD(larr, "Larrivee") +PROJ_HEAD(lask, "Laskowski") +PROJ_HEAD(lcc, "Lambert Conformal Conic") +PROJ_HEAD(leac, "Lambert Equal Area Conic") +PROJ_HEAD(lee_os, "Lee Oblated Stereographic") +PROJ_HEAD(loxim, "Loximuthal") +PROJ_HEAD(lsat, "Space oblique for LANDSAT") +PROJ_HEAD(mbt_s, "McBryde-Thomas Flat-Polar Sine") +PROJ_HEAD(mbt_fps, "McBryde-Thomas Flat-Pole Sine (No. 2)") +PROJ_HEAD(mbtfpp, "McBride-Thomas Flat-Polar Parabolic") +PROJ_HEAD(mbtfpq, "McBryde-Thomas Flat-Polar Quartic") +PROJ_HEAD(mbtfps, "McBryde-Thomas Flat-Polar Sinusoidal") +PROJ_HEAD(merc, "Mercator") +PROJ_HEAD(mil_os, "Miller Oblated Stereographic") +PROJ_HEAD(mill, "Miller Cylindrical") +PROJ_HEAD(mpoly, "Modified Polyconic") +PROJ_HEAD(moll, "Mollweide") +PROJ_HEAD(murd1, "Murdoch I") +PROJ_HEAD(murd2, "Murdoch II") +PROJ_HEAD(murd3, "Murdoch III") +PROJ_HEAD(nell, "Nell") +PROJ_HEAD(nell_h, "Nell-Hammer") +PROJ_HEAD(nicol, "Nicolosi Globular") +PROJ_HEAD(nsper, "Near-sided perspective") +PROJ_HEAD(nzmg, "New Zealand Map Grid") +PROJ_HEAD(ob_tran, "General Oblique Transformation") +PROJ_HEAD(ocea, "Oblique Cylindrical Equal Area") +PROJ_HEAD(oea, "Oblated Equal Area") +PROJ_HEAD(omerc, "Oblique Mercator") +PROJ_HEAD(ortel, "Ortelius Oval") +PROJ_HEAD(ortho, "Orthographic") +PROJ_HEAD(pconic, "Perspective Conic") +PROJ_HEAD(poly, "Polyconic (American)") +PROJ_HEAD(putp1, "Putnins P1") +PROJ_HEAD(putp2, "Putnins P2") +PROJ_HEAD(putp3, "Putnins P3") +PROJ_HEAD(putp3p, "Putnins P3'") +PROJ_HEAD(putp4p, "Putnins P4'") +PROJ_HEAD(putp5, "Putnins P5") +PROJ_HEAD(putp5p, "Putnins P5'") +PROJ_HEAD(putp6, "Putnins P6") +PROJ_HEAD(putp6p, "Putnins P6'") +PROJ_HEAD(qua_aut, "Quartic Authalic") +PROJ_HEAD(robin, "Robinson") +PROJ_HEAD(rpoly, "Rectangular Polyconic") +PROJ_HEAD(sinu, "Sinusoidal (Sanson-Flamsteed)") +PROJ_HEAD(somerc, "Swiss. Obl. Mercator") +PROJ_HEAD(stere, "Stereographic") +PROJ_HEAD(tcc, "Transverse Central Cylindrical") +PROJ_HEAD(tcea, "Transverse Cylindrical Equal Area") +PROJ_HEAD(tissot, "Tissot Conic") +PROJ_HEAD(tmerc, "Transverse Mercator") +PROJ_HEAD(tpeqd, "Two Point Equidistant") +PROJ_HEAD(tpers, "Tilted perspective") +PROJ_HEAD(ups, "Universal Polar Stereographic") +PROJ_HEAD(urm5, "Urmaev V") +PROJ_HEAD(urmfps, "Urmaev Flat-Polar Sinusoidal") +PROJ_HEAD(utm, "Universal Transverse Mercator (UTM)") +PROJ_HEAD(vandg, "van der Grinten (I)") +PROJ_HEAD(vandg2, "van der Grinten II") +PROJ_HEAD(vandg3, "van der Grinten III") +PROJ_HEAD(vandg4, "van der Grinten IV") +PROJ_HEAD(vitk1, "Vitkovsky I") +PROJ_HEAD(wag1, "Wagner I (Kavraisky VI)") +PROJ_HEAD(wag2, "Wagner II") +PROJ_HEAD(wag3, "Wagner III") +PROJ_HEAD(wag4, "Wagner IV") +PROJ_HEAD(wag5, "Wagner V") +PROJ_HEAD(wag6, "Wagner VI") +PROJ_HEAD(wag7, "Wagner VII") +PROJ_HEAD(weren, "Werenskiold I") +PROJ_HEAD(wink1, "Winkel I") +PROJ_HEAD(wink2, "Winkel II") +PROJ_HEAD(wintri, "Winkel Tripel") diff --git a/src/pj_malloc.c b/src/pj_malloc.c new file mode 100644 index 00000000..6beb502a --- /dev/null +++ b/src/pj_malloc.c @@ -0,0 +1,16 @@ +/* allocate and deallocate memory */ +#ifndef lint +static const char SCCSID[]="@(#)pj_malloc.c 4.3 93/06/12 GIE REL"; +#endif +/* These routines are used so that applications can readily replace +** projection system memory allocation/deallocation call with custom +** application procedures. */ +#include <projects.h> + void * +pj_malloc(size_t size) { + return(malloc(size)); +} + void +pj_dalloc(void *ptr) { + free(ptr); +} diff --git a/src/pj_mlfn.c b/src/pj_mlfn.c new file mode 100644 index 00000000..0b980c06 --- /dev/null +++ b/src/pj_mlfn.c @@ -0,0 +1,60 @@ +#ifndef lint +static const char SCCSID[]="@(#)pj_mlfn.c 4.5 95/07/06 GIE REL"; +#endif +#include <projects.h> +/* meridinal distance for ellipsoid and inverse +** 8th degree - accurate to < 1e-5 meters when used in conjuction +** with typical major axis values. +** Inverse determines phi to EPS (1e-11) radians, about 1e-6 seconds. +*/ +#define C00 1. +#define C02 .25 +#define C04 .046875 +#define C06 .01953125 +#define C08 .01068115234375 +#define C22 .75 +#define C44 .46875 +#define C46 .01302083333333333333 +#define C48 .00712076822916666666 +#define C66 .36458333333333333333 +#define C68 .00569661458333333333 +#define C88 .3076171875 +#define EPS 1e-11 +#define MAX_ITER 10 +#define EN_SIZE 5 + double * +pj_enfn(double es) { + double t, *en; + + if (en = (double *)pj_malloc(EN_SIZE * sizeof(double))) { + en[0] = C00 - es * (C02 + es * (C04 + es * (C06 + es * C08))); + en[1] = es * (C22 - es * (C04 + es * (C06 + es * C08))); + en[2] = (t = es * es) * (C44 - es * (C46 + es * C48)); + en[3] = (t *= es) * (C66 - es * C68); + en[4] = t * es * C88; + } /* else return NULL if unable to allocate memory */ + return en; +} + double +pj_mlfn(double phi, double sphi, double cphi, double *en) { + cphi *= sphi; + sphi *= sphi; + return(en[0] * phi - cphi * (en[1] + sphi*(en[2] + + sphi*(en[3] + sphi*en[4])))); +} + double +pj_inv_mlfn(double arg, double es, double *en) { + double s, t, phi, k = 1./(1.-es); + int i; + + phi = arg; + for (i = MAX_ITER; i ; --i) { /* rarely goes over 2 iterations */ + s = sin(phi); + t = 1. - es * s * s; + phi -= t = (pj_mlfn(phi, s, cos(phi), en) - arg) * (t * sqrt(t)) * k; + if (fabs(t) < EPS) + return phi; + } + pj_errno = -17; + return phi; +} diff --git a/src/pj_msfn.c b/src/pj_msfn.c new file mode 100644 index 00000000..55e3983c --- /dev/null +++ b/src/pj_msfn.c @@ -0,0 +1,9 @@ +/* determine constant small m */ +#ifndef lint +static const char SCCSID[]="@(#)pj_msfn.c 4.3 93/06/12 GIE REL"; +#endif +#include <math.h> + double +pj_msfn(double sinphi, double cosphi, double es) { + return (cosphi / sqrt (1. - es * sinphi * sinphi)); +} diff --git a/src/pj_open_lib.c b/src/pj_open_lib.c new file mode 100644 index 00000000..3de0ad3e --- /dev/null +++ b/src/pj_open_lib.c @@ -0,0 +1,49 @@ +/* standard location file open procedure */ +#ifndef lint +static const char SCCSID[]="@(#)pj_open_lib.c 4.5 94/10/30 GIE REL"; +#endif +#define PJ_LIB__ +#include <projects.h> +#include <stdio.h> +#include <string.h> +#include <errno.h> + static char * +proj_lib_name = +#ifdef PROJ_LIB +PROJ_LIB; +#else +0; +#endif + FILE * +pj_open_lib(char *name, char *mode) { + char fname[MAX_PATH_FILENAME+1], *sysname; + FILE *fid; + int n = 0; + + /* check if ~/name */ + if (*name == '~' && name[1] == DIR_CHAR) + if (sysname = getenv("HOME")) { + (void)strcpy(fname, sysname); + fname[n = strlen(fname)] = DIR_CHAR; + fname[++n] = '\0'; + (void)strcpy(fname+n, name + 1); + sysname = fname; + } else + return NULL; + /* or fixed path: /name, ./name or ../name */ + else if (*name == DIR_CHAR || (*name == '.' && name[1] == DIR_CHAR) || + (!strncmp(name, "..", 2) && name[2] == DIR_CHAR) ) + sysname = name; + /* or is environment PROJ_LIB defined */ + else if ((sysname = getenv("PROJ_LIB")) || (sysname = proj_lib_name)) { + (void)strcpy(fname, sysname); + fname[n = strlen(fname)] = DIR_CHAR; + fname[++n] = '\0'; + (void)strcpy(fname+n, name); + sysname = fname; + } else /* just try it bare bones */ + sysname = name; + if (fid = fopen(sysname, mode)) + errno = 0; + return(fid); +} diff --git a/src/pj_param.c b/src/pj_param.c new file mode 100644 index 00000000..25b104d4 --- /dev/null +++ b/src/pj_param.c @@ -0,0 +1,89 @@ +/* put parameters in linked list and retrieve */ +#ifndef lint +static const char SCCSID[]="@(#)pj_param.c 4.4 93/06/12 GIE REL"; +#endif +#include <projects.h> +#include <stdio.h> +#include <string.h> + paralist * /* create parameter list entry */ +pj_mkparam(char *str) { + paralist *new; + + if (new = (paralist *)pj_malloc(sizeof(paralist) + strlen(str))) { + new->used = 0; + new->next = 0; + if (*str == '+') + ++str; + (void)strcpy(new->param, str); + } + return new; +} + PVALUE /* test for presence or get parameter value */ +pj_param(paralist *pl, char *opt) { + int type; + unsigned l; + PVALUE value; + + type = *opt++; + /* simple linear lookup */ + l = strlen(opt); + while (pl && !(!strncmp(pl->param, opt, l) && + (!pl->param[l] || pl->param[l] == '='))) + pl = pl->next; + if (type == 't') + value.i = pl != 0; + else if (pl) { + pl->used |= 1; + opt = pl->param + l; + if (*opt == '=') + ++opt; + switch (type) { + case 'i': /* integer input */ + value.i = atoi(opt); + break; + case 'd': /* simple real input */ + value.f = atof(opt); + break; + case 'r': /* degrees input */ + value.f = dmstor(opt, 0); + break; + case 's': /* char string */ + value.s = opt; + break; + case 'b': /* boolean */ + switch (*opt) { + case 'F': case 'f': + value.i = 0; + break; + case '\0': case 'T': case 't': + value.i = 1; + break; + default: + pj_errno = -8; + value.i = 0; + break; + } + break; + default: +bum_type: /* note: this is an error in parameter, not a user error */ + fprintf(stderr, "invalid request to pj_param, fatal\n"); + exit(1); + } + } else /* not given */ + switch (type) { + case 'b': + case 'i': + value.i = 0; + break; + case 'd': + case 'r': + value.f = 0.; + break; + case 's': + value.s = 0; + break; + default: + goto bum_type; + } + return value; +} diff --git a/src/pj_phi2.c b/src/pj_phi2.c new file mode 100644 index 00000000..dbb79d4d --- /dev/null +++ b/src/pj_phi2.c @@ -0,0 +1,28 @@ +/* determine latitude angle phi-2 */ +#ifndef lint +static const char SCCSID[]="@(#)pj_phi2.c 4.3 93/06/12 GIE REL"; +#endif +#include <projects.h> + +#define HALFPI 1.5707963267948966 +#define TOL 1.0e-10 +#define N_ITER 15 + + double +pj_phi2(double ts, double e) { + double eccnth, Phi, con, dphi; + int i; + + eccnth = .5 * e; + Phi = HALFPI - 2. * atan (ts); + i = N_ITER; + do { + con = e * sin (Phi); + dphi = HALFPI - 2. * atan (ts * pow((1. - con) / + (1. + con), eccnth)) - Phi; + Phi += dphi; + } while ( fabs(dphi) > TOL && --i); + if (i <= 0) + pj_errno = -18; + return Phi; +} diff --git a/src/pj_pr_list.c b/src/pj_pr_list.c new file mode 100644 index 00000000..e4feeda6 --- /dev/null +++ b/src/pj_pr_list.c @@ -0,0 +1,48 @@ +/* print projection's list of parameters */ +#ifndef lint +static const char SCCSID[]="@(#)pj_pr_list.c 4.6 94/03/19 GIE REL"; +#endif +#include <projects.h> +#include <stdio.h> +#include <string.h> +#define LINE_LEN 72 + static int +pr_list(PJ *P, int not_used) { + paralist *t; + int l, n = 1, flag = 0; + + (void)putchar('#'); + for (t = P->params; t; t = t->next) + if ((!not_used && t->used) || (not_used && !t->used)) { + l = strlen(t->param) + 1; + if (n + l > LINE_LEN) { + (void)fputs("\n#", stdout); + n = 2; + } + (void)putchar(' '); + if (*(t->param) != '+') + (void)putchar('+'); + (void)fputs(t->param, stdout); + n += l; + } else + flag = 1; + if (n > 1) + (void)putchar('\n'); + return flag; +} + void /* print link list of projection parameters */ +pj_pr_list(PJ *P) { + char const *s; + + (void)putchar('#'); + for (s = P->descr; *s ; ++s) { + (void)putchar(*s); + if (*s == '\n') + (void)putchar('#'); + } + (void)putchar('\n'); + if (pr_list(P, 0)) { + (void)fputs("#--- following specified but NOT used\n", stdout); + (void)pr_list(P, 1); + } +} diff --git a/src/pj_qsfn.c b/src/pj_qsfn.c new file mode 100644 index 00000000..c0610be3 --- /dev/null +++ b/src/pj_qsfn.c @@ -0,0 +1,17 @@ +/* determine small q */ +#ifndef lint +static const char SCCSID[]="@(#)pj_qsfn.c 4.3 93/06/12 GIE REL"; +#endif +#include <math.h> +# define EPSILON 1.0e-7 + double +pj_qsfn(double sinphi, double e, double one_es) { + double con; + + if (e >= EPSILON) { + con = e * sinphi; + return (one_es * (sinphi / (1. - con * con) - + (.5 / e) * log ((1. - con) / (1. + con)))); + } else + return (sinphi + sinphi); +} diff --git a/src/pj_release.c b/src/pj_release.c new file mode 100644 index 00000000..a01d3b2e --- /dev/null +++ b/src/pj_release.c @@ -0,0 +1,6 @@ +/* <<< Release Notice for library >>> */ +#ifndef lint +static const char SCCSID[]="@(#)pj_release.c 4.5 95/09/23 GIE REL"; +#endif + +char const pj_release[]="Rel. 4.3.3, 23 Sept. 1995"; diff --git a/src/pj_strerrno.c b/src/pj_strerrno.c new file mode 100644 index 00000000..4e5192fc --- /dev/null +++ b/src/pj_strerrno.c @@ -0,0 +1,72 @@ +/* list of projection system pj_errno values */ +#ifndef lint +static const char SCCSID[]="@(#)pj_strerrno.c 4.12 94/05/25 GIE REL"; +#endif +#include <errno.h> +#include <string.h> + static char * +pj_err_list[] = { + "no arguments in initialization list", /* -1 */ + "no options found in 'init' file", /* -2 */ + "no colon in init= string", /* -3 */ + "projection not named", /* -4 */ + "unknown projection id", /* -5 */ + "effective eccentricity = 1.", /* -6 */ + "unknown unit conversion id", /* -7 */ + "invalid boolean param argument", /* -8 */ + "unknown elliptical parameter name", /* -9 */ + "reciprocal flattening (1/f) = 0", /* -10 */ + "|radius reference latitude| > 90", /* -11 */ + "squared eccentricity < 0", /* -12 */ + "major axis or radius = 0 or not given", /* -13 */ + "latitude or longitude exceeded limits", /* -14 */ + "invalid x or y", /* -15 */ + "improperly formed DMS value", /* -16 */ + "non-convergent inverse meridinal dist", /* -17 */ + "non-convergent inverse phi2", /* -18 */ + "acos/asin: |arg| >1.+1e-14", /* -19 */ + "tolerance condition error", /* -20 */ + "conic lat_1 = -lat_2", /* -21 */ + "lat_1 >= 90", /* -22 */ + "lat_1 = 0", /* -23 */ + "lat_ts >= 90", /* -24 */ + "no distance between control points", /* -25 */ + "projection not selected to be rotated", /* -26 */ + "W <= 0 or M <= 0", /* -27 */ + "lsat not in 1-5 range", /* -28 */ + "path not in range", /* -29 */ + "h <= 0", /* -30 */ + "k <= 0", /* -31 */ + "lat_0 = 0 or 90 or alpha = 90", /* -32 */ + "lat_1=lat_2 or lat_1=0 or lat_2=90", /* -33 */ + "elliptical usage required", /* -34 */ + "invalid UTM zone number", /* -35 */ + "arg(s) out of range for Tcheby eval", /* -36 */ + "failed to find projection to be rotated", /* -37 */ + "failed to load NAD27-83 correction file", /* -38 */ + "both n & m must be spec'd and > 0", /* -39 */ + "n <= 0, n > 1 or not specified", /* -40 */ + "lat_1 or lat_2 not specified", /* -41 */ + "|lat_1| == |lat_2|", /* -42 */ + "lat_0 is pi/2 from mean lat", /* -43 */ +}; + char * +pj_strerrno(int err) { + if (err > 0) +#ifdef HAVE_STRERROR + return strerror(err); +#else + { static char note[50]; + sprintf(note,"no system list, errno: %d\n", err); + return note; + } +#endif + else if (err < 0) { + err = - err - 1; + if (err < (sizeof(pj_err_list) / sizeof(char *))) + return(pj_err_list[err]); + else + return("invalid projection system error number"); + } else + return 0; +} diff --git a/src/pj_tsfn.c b/src/pj_tsfn.c new file mode 100644 index 00000000..3c223e05 --- /dev/null +++ b/src/pj_tsfn.c @@ -0,0 +1,12 @@ +/* determine small t */ +#ifndef lint +static const char SCCSID[]="@(#)pj_tsfn.c 4.3 93/06/12 GIE REL"; +#endif +#include <math.h> +#define HALFPI 1.5707963267948966 + double +pj_tsfn(double phi, double sinphi, double e) { + sinphi *= e; + return (tan (.5 * (HALFPI - phi)) / + pow((1. - sinphi) / (1. + sinphi), .5 * e)); +} diff --git a/src/pj_units.c b/src/pj_units.c new file mode 100644 index 00000000..a29b3a18 --- /dev/null +++ b/src/pj_units.c @@ -0,0 +1,34 @@ +/* definition of standard cartesian units */ +#ifndef lint +static const char SCCSID[]="@(#)pj_units.c 4.6 93/06/12 GIE REL"; +#endif +#define PJ_UNITS__ +#include <projects.h> +/* Field 2 that contains the multiplier to convert named units to meters +** may be expressed by either a simple floating point constant or a +** numerator/denomenator values (e.g. 1/1000) */ + struct PJ_UNITS +pj_units[] = { + "km", "1000.", "Kilometer", + "m", "1.", "Meter", + "dm", "1/10", "Decimeter", + "cm", "1/100", "Centimeter", + "mm", "1/1000", "Millimeter", + "kmi", "1852.0", "International Nautical Mile", + "in", "0.0254", "International Inch", + "ft", "0.3048", "International Foot", + "yd", "0.9144", "International Yard", + "mi", "1609.344", "International Statute Mile", + "fath", "1.8288", "International Fathom", + "ch", "20.1168", "International Chain", + "link", "0.201168", "International Link", + "us-in", "1./39.37", "U.S. Surveyor's Inch", + "us-ft", "0.304800609601219", "U.S. Surveyor's Foot", + "us-yd", "0.914401828803658", "U.S. Surveyor's Yard", + "us-ch", "20.11684023368047", "U.S. Surveyor's Chain", + "us-mi", "1609.347218694437", "U.S. Surveyor's Statute Mile", + "ind-yd", "0.91439523", "Indian Yard", + "ind-ft", "0.30479841", "Indian Foot", + "ind-ch", "20.11669506", "Indian Chain", +(char *)0, (char *)0, (char *)0 +}; diff --git a/src/pj_zpoly1.c b/src/pj_zpoly1.c new file mode 100644 index 00000000..80d85469 --- /dev/null +++ b/src/pj_zpoly1.c @@ -0,0 +1,49 @@ +/* evaluate complex polynomial */ +#ifndef lint +static const char SCCSID[]="@(#)pj_zpoly1.c 4.3 93/06/12 GIE REL"; +#endif +#include <projects.h> +/* note: coefficients are always from C_1 to C_n +** i.e. C_0 == (0., 0) +** n should always be >= 1 though no checks are made +*/ + COMPLEX +pj_zpoly1(COMPLEX z, COMPLEX *C, int n) { + COMPLEX a; + double t; + + a = *(C += n); + while (n-- > 0) { + a.r = (--C)->r + z.r * (t = a.r) - z.i * a.i; + a.i = C->i + z.r * a.i + z.i * t; + } + a.r = z.r * (t = a.r) - z.i * a.i; + a.i = z.r * a.i + z.i * t; + return a; +} +/* evaluate complex polynomial and derivative */ + COMPLEX +pj_zpolyd1(COMPLEX z, COMPLEX *C, int n, COMPLEX *der) { + COMPLEX a, b; + double t; + int first = 1; + + a = *(C += n); + while (n-- > 0) { + if (first) { + first = 0; + b = a; + } else { + b.r = a.r + z.r * (t = b.r) - z.i * b.i; + b.i = a.i + z.r * b.i + z.i * t; + } + a.r = (--C)->r + z.r * (t = a.r) - z.i * a.i; + a.i = C->i + z.r * a.i + z.i * t; + } + b.r = a.r + z.r * (t = b.r) - z.i * b.i; + b.i = a.i + z.r * b.i + z.i * t; + a.r = z.r * (t = a.r) - z.i * a.i; + a.i = z.r * a.i + z.i * t; + *der = b; + return a; +} diff --git a/src/proj.c b/src/proj.c new file mode 100644 index 00000000..e14b5b26 --- /dev/null +++ b/src/proj.c @@ -0,0 +1,454 @@ +/* <<<< Cartographic projection filter program >>>> */ +#ifndef lint +static const char SCCSID[]="@(#)proj.c 4.12 95/09/23 GIE REL"; +#endif +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> +#include <string.h> +#include <math.h> +#include "projects.h" +#include "emess.h" + +#define MAX_LINE 200 +#define MAX_PARGS 100 +#define PJ_INVERS(P) (P->inv ? 1 : 0) + static PJ +*Proj; + static UV +(*proj)(UV, PJ *); + static int +reversein = 0, /* != 0 reverse input arguments */ +reverseout = 0, /* != 0 reverse output arguments */ +bin_in = 0, /* != 0 then binary input */ +bin_out = 0, /* != 0 then binary output */ +echoin = 0, /* echo input data to output line */ +tag = '#', /* beginning of line tag character */ +inverse = 0, /* != 0 then inverse projection */ +prescale = 0, /* != 0 apply cartesian scale factor */ +dofactors = 0, /* determine scale factors */ +facs_bad = 0, /* return condition from pj_factors */ +very_verby = 0, /* very verbose mode */ +postscale = 0; + static char +*cheby_str, /* string controlling Chebychev evaluation */ +*oform = (char *)0, /* output format for x-y or decimal degrees */ +*oterr = "*\t*", /* output line for unprojectable input */ +*usage = +"%s\nusage: %s [ -beEfiIlormsStTvVwW [args] ] [ +opts[=arg] ] [ files ]\n"; + static struct FACTORS +facs; + static double +(*informat)(const char *, char **), /* input data deformatter function */ +fscale = 0.; /* cartesian scale factor */ + static UV +int_proj(data) UV data; { + if (prescale) { data.u *= fscale; data.v *= fscale; } + data = (*proj)(data, Proj); + if (postscale && data.u != HUGE_VAL) + { data.u *= fscale; data.v *= fscale; } + return(data); +} + static void /* file processing function */ +process(FILE *fid) { + char line[MAX_LINE+3], *s, pline[40]; + UV data; + + for (;;) { + ++emess_dat.File_line; + if (bin_in) { /* binary input */ + if (fread(&data, sizeof(UV), 1, fid) != 1) + break; + } else { /* ascii input */ + if (!(s = fgets(line, MAX_LINE, fid))) + break; + if (!strchr(s, '\n')) { /* overlong line */ + int c; + (void)strcat(s, "\n"); + /* gobble up to newline */ + while ((c = fgetc(fid)) != EOF && c != '\n') ; + } + if (*s == tag) { + if (!bin_out) + (void)fputs(line, stdout); + continue; + } + if (reversein) { + data.v = (*informat)(s, &s); + data.u = (*informat)(s, &s); + } else { + data.u = (*informat)(s, &s); + data.v = (*informat)(s, &s); + } + if (data.v == HUGE_VAL) + data.u = HUGE_VAL; + if (!*s && (s > line)) --s; /* assumed we gobbled \n */ + if (!bin_out && echoin) { + int t; + t = *s; + *s = '\0'; + (void)fputs(line, stdout); + *s = t; + putchar('\t'); + } + } + if (data.u != HUGE_VAL) { + if (prescale) { data.u *= fscale; data.v *= fscale; } + if (dofactors && !inverse) + facs_bad = pj_factors(data, Proj, 0., &facs); + data = (*proj)(data, Proj); + if (dofactors && inverse) + facs_bad = pj_factors(data, Proj, 0., &facs); + if (postscale && data.u != HUGE_VAL) + { data.u *= fscale; data.v *= fscale; } + } + if (bin_out) { /* binary output */ + (void)fwrite(&data, sizeof(UV), 1, stdout); + continue; + } else if (data.u == HUGE_VAL) /* error output */ + (void)fputs(oterr, stdout); + else if (inverse && !oform) { /*ascii DMS output */ + if (reverseout) { + (void)fputs(rtodms(pline, data.v, 'N', 'S'), stdout); + putchar('\t'); + (void)fputs(rtodms(pline, data.u, 'E', 'W'), stdout); + } else { + (void)fputs(rtodms(pline, data.u, 'E', 'W'), stdout); + putchar('\t'); + (void)fputs(rtodms(pline, data.v, 'N', 'S'), stdout); + } + } else { /* x-y or decimal degree ascii output */ + if (inverse) { + data.v *= RAD_TO_DEG; + data.u *= RAD_TO_DEG; + } + if (reverseout) { + (void)printf(oform,data.v); putchar('\t'); + (void)printf(oform,data.u); + } else { + (void)printf(oform,data.u); putchar('\t'); + (void)printf(oform,data.v); + } + } + if (dofactors) /* print scale factor data */ + if (!facs_bad) + (void)printf("\t<%g %g %g %g %g %g>", + facs.h, facs.k, facs.s, + facs.omega * RAD_TO_DEG, facs.a, facs.b); + else + (void)fputs("\t<* * * * * *>", stdout); + (void)fputs(bin_in ? "\n" : s, stdout); + } +} + static void /* file processing function --- verbosely */ +vprocess(FILE *fid) { + char line[MAX_LINE+3], *s, pline[40]; + UV dat_ll, dat_xy; + int linvers; + + if (!oform) + oform = "%.3f"; + if (bin_in || bin_out) + emess(1,"binary I/O not available in -V option"); + for (;;) { + ++emess_dat.File_line; + if (!(s = fgets(line, MAX_LINE, fid))) + break; + if (!strchr(s, '\n')) { /* overlong line */ + int c; + (void)strcat(s, "\n"); + /* gobble up to newline */ + while ((c = fgetc(fid)) != EOF && c != '\n') ; + } + if (*s == tag) { /* pass on data */ + (void)fputs(s, stdout); + continue; + } + /* check to override default input mode */ + if (*s == 'I' || *s == 'i') { + linvers = 1; + ++s; + } else if (*s == 'I' || *s == 'i') { + linvers = 0; + ++s; + } else + linvers = inverse; + if (linvers) { + if (!PJ_INVERS(Proj)) { + emess(-1,"inverse for this projection not avail.\n"); + continue; + } + dat_xy.u = strtod(s, &s); + dat_xy.v = strtod(s, &s); + if (dat_xy.u == HUGE_VAL || dat_xy.v == HUGE_VAL) { + emess(-1,"lon-lat input conversion failure\n"); + continue; + } + if (prescale) { dat_xy.u *= fscale; dat_xy.v *= fscale; } + dat_ll = pj_inv(dat_xy, Proj); + } else { + dat_ll.u = dmstor(s, &s); + dat_ll.v = dmstor(s, &s); + if (dat_ll.u == HUGE_VAL || dat_ll.v == HUGE_VAL) { + emess(-1,"lon-lat input conversion failure\n"); + continue; + } + dat_xy = pj_fwd(dat_ll, Proj); + if (postscale) { dat_xy.u *= fscale; dat_xy.v *= fscale; } + } + if (pj_errno) { + emess(-1, pj_strerrno(pj_errno)); + continue; + } + if (!*s && (s > line)) --s; /* assumed we gobbled \n */ + if (pj_factors(dat_ll, Proj, 0., &facs)) { + emess(-1,"failed to conpute factors\n\n"); + continue; + } + if (*s != '\n') + (void)fputs(s, stdout); + (void)fputs("Longitude: ", stdout); + (void)fputs(rtodms(pline, dat_ll.u, 'E', 'W'), stdout); + (void)printf(" [ %.11g ]\n", dat_ll.u * RAD_TO_DEG); + (void)fputs("Latitude: ", stdout); + (void)fputs(rtodms(pline, dat_ll.v, 'N', 'S'), stdout); + (void)printf(" [ %.11g ]\n", dat_ll.v * RAD_TO_DEG); + (void)fputs("Easting (x): ", stdout); + (void)printf(oform, dat_xy.u); putchar('\n'); + (void)fputs("Northing (y): ", stdout); + (void)printf(oform, dat_xy.v); putchar('\n'); + (void)printf("Meridian scale (h)%c: %.8f ( %.4g %% error )\n", + facs.code & IS_ANAL_HK ? '*' : ' ', facs.h, (facs.h-1.)*100.); + (void)printf("Parallel scale (k)%c: %.8f ( %.4g %% error )\n", + facs.code & IS_ANAL_HK ? '*' : ' ', facs.k, (facs.k-1.)*100.); + (void)printf("Areal scale (s): %.8f ( %.4g %% error )\n", + facs.s, (facs.s-1.)*100.); + (void)printf("Angular distortion (w): %.3f\n", facs.omega * + RAD_TO_DEG); + (void)printf("Meridian/Parallel angle: %.5f\n", + facs.thetap * RAD_TO_DEG); + (void)printf("Convergence%c: ",facs.code & IS_ANAL_CONV ? '*' : ' '); + (void)fputs(rtodms(pline, facs.conv, 0, 0), stdout); + (void)printf(" [ %.8f ]\n", facs.conv * RAD_TO_DEG); + (void)printf("Max-min (Tissot axis a-b) scale error: %.5f %.5f\n\n", + facs.a, facs.b); + } +} + void +main(int argc, char **argv) { + char *arg, **eargv = argv, *pargv[MAX_PARGS], **iargv = argv; + FILE *fid; + int pargc = 0, iargc = argc, eargc = 0, c, mon = 0; + + if (emess_dat.Prog_name = strrchr(*argv,DIR_CHAR)) + ++emess_dat.Prog_name; + else emess_dat.Prog_name = *argv; + inverse = ! strncmp(emess_dat.Prog_name, "inv", 3); + if (argc <= 1 ) { + (void)fprintf(stderr, usage, pj_release, emess_dat.Prog_name); + exit (0); + } + /* process run line arguments */ + while (--argc > 0) { /* collect run line arguments */ + if(**++argv == '-') for(arg = *argv;;) { + switch(*++arg) { + case '\0': /* position of "stdin" */ + if (arg[-1] == '-') eargv[eargc++] = "-"; + break; + case 'b': /* binary I/O */ + bin_in = bin_out = 1; + continue; + case 'v': /* monitor dump of initialization */ + mon = 1; + continue; + case 'i': /* input binary */ + bin_in = 1; + continue; + case 'o': /* output binary */ + bin_out = 1; + continue; + case 'I': /* alt. method to spec inverse */ + inverse = 1; + continue; + case 'E': /* echo ascii input to ascii output */ + echoin = 1; + continue; + case 'V': /* very verbose processing mode */ + very_verby = 1; + mon = 1; + case 'S': /* compute scale factors */ + dofactors = 1; + continue; + case 't': /* set col. one char */ + if (arg[1]) tag = *++arg; + else emess(1,"missing -t col. 1 tag"); + continue; + case 'l': /* list projections, ellipses or units */ + if (!arg[1] || arg[1] == 'p' || arg[1] == 'P') { + /* list projections */ + struct PJ_LIST *lp; + int do_long = arg[1] == 'P', c; + char *str; + + for (lp = pj_list ; lp->id ; ++lp) { + (void)printf("%s : ", lp->id); + if (do_long) /* possibly multiline description */ + (void)puts(*lp->descr); + else { /* first line, only */ + str = *lp->descr; + while ((c = *str++) && c != '\n') + putchar(c); + putchar('\n'); + } + } + } else if (arg[1] == '=') { /* list projection 'descr' */ + struct PJ_LIST *lp; + + arg += 2; + for (lp = pj_list ; lp->id ; ++lp) + if (!strcmp(lp->id, arg)) { + (void)printf("%9s : %s\n", lp->id, *lp->descr); + break; + } + } else if (arg[1] == 'e') { /* list ellipses */ + struct PJ_ELLPS *le; + + for (le = pj_ellps; le->id ; ++le) + (void)printf("%9s %-16s %-16s %s\n", + le->id, le->major, le->ell, le->name); + } else if (arg[1] == 'u') { /* list units */ + struct PJ_UNITS *lu; + + for (lu = pj_units; lu->id ; ++lu) + (void)printf("%12s %-20s %s\n", + lu->id, lu->to_meter, lu->name); + } else + emess(1,"invalid list option: l%c",arg[1]); + exit(0); + continue; /* artificial */ + case 'e': /* error line alternative */ + if (--argc <= 0) +noargument: emess(1,"missing argument for -%c",*arg); + oterr = *++argv; + continue; + case 'T': /* generate Chebyshev coefficients */ + if (--argc <= 0) goto noargument; + cheby_str = *++argv; + continue; + case 'm': /* cartesian multiplier */ + if (--argc <= 0) goto noargument; + postscale = 1; + if (!strncmp("1/",*++argv,2) || + !strncmp("1:",*argv,2)) { + if((fscale = atof((*argv)+2)) == 0.) + goto badscale; + fscale = 1. / fscale; + } else + if ((fscale = atof(*argv)) == 0.) { +badscale: + emess(1,"invalid scale argument"); + } + continue; + case 'W': /* specify seconds precision */ + case 'w': /* -W for constant field width */ + if ((c = arg[1]) != 0 && isdigit(c)) { + set_rtodms(c - '0', *arg == 'W'); + ++arg; + } else + emess(1,"-W argument missing or non-digit"); + continue; + case 'f': /* alternate output format degrees or xy */ + if (--argc <= 0) goto noargument; + oform = *++argv; + continue; + case 'r': /* reverse input */ + reversein = 1; + continue; + case 's': /* reverse output */ + reverseout = 1; + continue; + default: + emess(1, "invalid option: -%c",*arg); + break; + } + break; + } else if (**argv == '+') { /* + argument */ + if (pargc < MAX_PARGS) + pargv[pargc++] = *argv + 1; + else + emess(1,"overflowed + argument table"); + } else /* assumed to be input file name(s) */ + eargv[eargc++] = *argv; + } + if (eargc == 0 && !cheby_str) /* if no specific files force sysin */ + eargv[eargc++] = "-"; + else if (eargc > 0 && cheby_str) /* warning */ + emess(4, "data files when generating Chebychev prohibited"); + /* done with parameter and control input */ + if (inverse && postscale) { + prescale = 1; + postscale = 0; + fscale = 1./fscale; + } + if (!(Proj = pj_init(pargc, pargv))) + emess(3,"projection initialization failure\ncause: %s", + pj_strerrno(pj_errno)); + if (inverse) { + if (!Proj->inv) + emess(3,"inverse projection not available"); + proj = pj_inv; + } else + proj = pj_fwd; + if (cheby_str) { + extern void gen_cheb(int, UV(*)(), char *, PJ *, int, char **); + + gen_cheb(inverse, int_proj, cheby_str, Proj, iargc, iargv); + exit(0); + } + /* set input formating control */ + if (mon) { + pj_pr_list(Proj); + if (very_verby) { + (void)printf("#Final Earth figure: "); + if (Proj->es) { + (void)printf("ellipsoid\n# Major axis (a): "); + (void)printf(oform ? oform : "%.3f", Proj->a); + (void)printf("\n# 1/flattening: %.6f\n", + 1./(1. - sqrt(1. - Proj->es))); + (void)printf("# squared eccentricity: %.12f\n", Proj->es); + } else { + (void)printf("sphere\n# Radius: "); + (void)printf(oform ? oform : "%.3f", Proj->a); + (void)putchar('\n'); + } + } + } + if (inverse) + informat = strtod; + else { + informat = dmstor; + if (!oform) + oform = "%.2f"; + } + /* process input file list */ + for ( ; eargc-- ; ++eargv) { + if (**eargv == '-') { + fid = stdin; + emess_dat.File_name = "<stdin>"; + } else { + if ((fid = fopen(*eargv, "r")) == NULL) { + emess(-2, *eargv, "input file"); + continue; + } + emess_dat.File_name = *eargv; + } + emess_dat.File_line = 0; + if (very_verby) + vprocess(fid); + else + process(fid); + (void)fclose(fid); + emess_dat.File_name = 0; + } + exit(0); /* normal completion */ +} diff --git a/src/projects.h b/src/projects.h new file mode 100644 index 00000000..7f4a30c3 --- /dev/null +++ b/src/projects.h @@ -0,0 +1,240 @@ +/* General projections header file */ +#ifndef PROJECTS_H +#define PROJECTS_H + +#ifndef lint +static const char PROJECTS_H_ID[] = "@(#)projects.h 4.11 95/09/23 GIE REL"; +#endif + /* standard inclusions */ +#include <math.h> +#include <stdlib.h> + /* maximum path/filename */ +#ifndef MAX_PATH_FILENAME +#define MAX_PATH_FILENAME 1024 +#endif + /* prototype hypot for systems where absent */ +extern double hypot(double, double); + /* some useful constants */ +#define HALFPI 1.5707963267948966 +#define FORTPI 0.78539816339744833 +#define PI 3.14159265358979323846 +#define TWOPI 6.2831853071795864769 +#define RAD_TO_DEG 57.29577951308232 +#define DEG_TO_RAD .0174532925199432958 + +/* environment parameter name */ +#ifndef PROJ_LIB +#define PROJ_LIB "PROJ_LIB" +#endif +/* maximum tag id length for +init and default files */ +#ifndef ID_TAG_MAX +#define ID_TAG_MAX 50 +#endif + +/* directory delimiter for DOS support */ +#ifdef DOS +#define DIR_CHAR '\\' +#else +#define DIR_CHAR '/' +#endif + +typedef struct { double u, v; } UV; +typedef struct { double r, i; } COMPLEX; + +#ifndef PJ_LIB__ +#define XY UV +#define LP UV +#else +typedef struct { double x, y; } XY; +typedef struct { double lam, phi; } LP; +#endif + + extern int /* global error return code */ +pj_errno; + +typedef union { double f; int i; char *s; } PVALUE; + +struct PJ_LIST { + char *id; /* projection keyword */ + void *(*proj)(); /* projection entry point */ + char * const *descr; /* description text */ +}; +struct PJ_ELLPS { + char *id; /* ellipse keyword name */ + char *major; /* a= value */ + char *ell; /* elliptical parameter */ + char *name; /* comments */ +}; +struct PJ_UNITS { + char *id; /* units keyword */ + char *to_meter; /* multiply by value to get meters */ + char *name; /* comments */ +}; +struct FACTORS { + struct DERIVS { + double x_l, x_p; /* derivatives of x for lambda-phi */ + double y_l, y_p; /* derivatives of y for lambda-phi */ + } der; + double h, k; /* meridinal, parallel scales */ + double omega, thetap; /* angular distortion, theta prime */ + double conv; /* convergence */ + double s; /* areal scale factor */ + double a, b; /* max-min scale error */ + int code; /* info as to analytics, see following */ +}; +#define IS_ANAL_XL_YL 01 /* derivatives of lon analytic */ +#define IS_ANAL_XP_YP 02 /* derivatives of lat analytic */ +#define IS_ANAL_HK 04 /* h and k analytic */ +#define IS_ANAL_CONV 010 /* convergence analytic */ + /* parameter list struct */ +typedef struct ARG_list { + struct ARG_list *next; + char used; + char param[1]; } paralist; + /* base projection data structure */ +typedef struct PJconsts { + XY (*fwd)(LP, struct PJconsts *); + LP (*inv)(XY, struct PJconsts *); + void (*spc)(LP, struct PJconsts *, struct FACTORS *); + void (*pfree)(struct PJconsts *); + const char *descr; + paralist *params; /* parameter list */ + int over; /* over-range flag */ + int geoc; /* geocentric latitude flag */ + double + a, /* major axis or radius if es==0 */ + e, /* eccentricity */ + es, /* e ^ 2 */ + ra, /* 1/A */ + one_es, /* 1 - e^2 */ + rone_es, /* 1/one_es */ + lam0, phi0, /* central longitude, latitude */ + x0, y0, /* easting and northing */ + k0, /* general scaling factor */ + to_meter, fr_meter; /* cartesian scaling */ +#ifdef PROJ_PARMS__ +PROJ_PARMS__ +#endif /* end of optional extensions */ +} PJ; + +/* Generate pj_list external or make list from include file */ +#ifndef PJ_LIST_H +extern struct PJ_LIST pj_list[]; +#else +#define PROJ_HEAD(id, name) \ + extern void *pj_##id(); extern char * const pj_s_##id; +#ifndef lint +#define DO_PJ_LIST_ID +#endif +#include PJ_LIST_H +#ifndef lint +#undef DO_PJ_LIST_ID +#endif +#undef PROJ_HEAD +#define PROJ_HEAD(id, name) {#id, pj_##id, &pj_s_##id}, + struct PJ_LIST +pj_list[] = { +#include PJ_LIST_H + {0, 0, 0}, + }; +#undef PROJ_HEAD +#endif + +#ifndef PJ_ELLPS__ +extern struct PJ_ELLPS pj_ellps[]; +#endif + +#ifndef PJ_UNITS__ +extern struct PJ_UNITS pj_units[]; +#endif + +#ifdef PJ_LIB__ + /* repeatative projection code */ +#define PROJ_HEAD(id, name) static const char des_##id [] = name +#define ENTRYA(name) const char * const pj_s_##name = des_##name; \ + PJ *pj_##name(PJ *P) { if (!P) { \ + if (P = pj_malloc(sizeof(PJ))) { \ + P->pfree = freeup; P->fwd = 0; P->inv = 0; \ + P->spc = 0; P->descr = des_##name; +#define ENTRYX } return P; } else { +#define ENTRY0(name) ENTRYA(name) ENTRYX +#define ENTRY1(name, a) ENTRYA(name) P->a = 0; ENTRYX +#define ENTRY2(name, a, b) ENTRYA(name) P->a = 0; P->b = 0; ENTRYX +#define ENDENTRY(p) } return (p); } +#define E_ERROR(err) { pj_errno = err; freeup(P); return(0); } +#define E_ERROR_0 { freeup(P); return(0); } +#define F_ERROR { pj_errno = -20; return(xy); } +#define I_ERROR { pj_errno = -20; return(lp); } +#define FORWARD(name) static XY name(LP lp, PJ *P) { XY xy +#define INVERSE(name) static LP name(XY xy, PJ *P) { LP lp +#define FREEUP static void freeup(PJ *P) { +#define SPECIAL(name) static void name(LP lp, PJ *P, struct FACTORS *fac) +#endif +#define MAX_TAB_ID 80 +typedef struct { float lam, phi; } FLP; +typedef struct { int lam, phi; } ILP; +struct CTABLE { + char id[MAX_TAB_ID]; /* ascii info */ + LP ll; /* lower left corner coordinates */ + LP del; /* size of cells */ + ILP lim; /* limits of conversion matrix */ + FLP *cvs; /* conversion matrix */ +}; + /* procedure prototypes */ +double dmstor(const char *, char **); +void set_rtodms(int, int); +char *rtodms(char *, double, int, int); +double adjlon(double); +double aacos(double), aasin(double), asqrt(double), aatan2(double, double); +PVALUE pj_param(paralist *, char *); +paralist *pj_mkparam(char *); +int pj_ell_set(paralist *, double *, double *); +double *pj_enfn(double); +double pj_mlfn(double, double, double, double *); +double pj_inv_mlfn(double, double, double *); +double pj_qsfn(double, double, double); +double pj_tsfn(double, double, double); +double pj_msfn(double, double, double); +double pj_phi2(double, double); +double pj_qsfn_(double, PJ *); +double *pj_authset(double); +double pj_authlat(double, double *); +COMPLEX pj_zpoly1(COMPLEX, COMPLEX *, int); +COMPLEX pj_zpolyd1(COMPLEX, COMPLEX *, int, COMPLEX *); +int pj_deriv(LP, double, PJ *, struct DERIVS *); +int pj_factors(LP, PJ *, double, struct FACTORS *); +XY pj_fwd(LP, PJ *); +LP pj_inv(XY, PJ *); +void pj_pr_list(PJ *); +void pj_free(PJ *); +PJ *pj_init(int, char **); +void *pj_malloc(size_t); +void pj_dalloc(void *); +char *pj_strerrno(int); +/* Approximation structures and procedures */ +typedef struct { /* Chebyshev or Power series structure */ + UV a, b; /* power series range for evaluation */ + /* or Chebyshev argument shift/scaling */ + struct PW_COEF {/* row coefficient structure */ + int m; /* number of c coefficients (=0 for none) */ + double *c; /* power coefficients */ + } *cu, *cv; + int mu, mv; /* maximum cu and cv index (+1 for count) */ + int power; /* != 0 if power series, else Chebyshev */ +} Tseries; +Tseries *mk_cheby(UV, UV, double, UV *, UV (*)(UV), int, int, int); +UV bpseval(UV, Tseries *); +UV bcheval(UV, Tseries *); +UV biveval(UV, Tseries *); +void *vector1(int, int); +void **vector2(int, int, int); +int bchgen(UV, UV, int, int, UV **, UV(*)(UV)); +int bch2bps(UV, UV, UV **, int, int); +/* nadcon related protos */ +LP nad_intr(LP, struct CTABLE *); +LP nad_cvt(LP, int, struct CTABLE *); +struct CTABLE *nad_init(char *); +void nad_free(struct CTABLE *); +extern char const pj_release[]; + +#endif /* end of basic projections header */ diff --git a/src/rtodms.c b/src/rtodms.c new file mode 100644 index 00000000..8af7e7b5 --- /dev/null +++ b/src/rtodms.c @@ -0,0 +1,73 @@ +/* Convert radian argument to DMS ascii format */ +#ifndef lint +static const char SCCSID[]="@(#)rtodms.c 4.3 93/06/12 GIE REL"; +#endif +#include <projects.h> +#include <stdio.h> +#include <string.h> +/* +** RES is fractional second figures +** RES60 = 60 * RES +** CONV = 180 * 3600 * RES / PI (radians to RES seconds) +*/ + static double +RES = 1000., +RES60 = 60000., +CONV = 206264806.24709635515796003417; + static char +format[50] = "%dd%d'%.3f\"%c"; + static int +dolong = 0; + void +set_rtodms(int fract, int con_w) { + int i; + + if (fract >= 0 && fract < 9 ) { + RES = 1.; + /* following not very elegant, but used infrequently */ + for (i = 0; i < fract; ++i) + RES *= 10.; + RES60 = RES * 60.; + CONV = 180. * 3600. * RES / PI; + if (! con_w) + (void)sprintf(format,"%%dd%%d'%%.%df\"%%c", fract); + else + (void)sprintf(format,"%%dd%%02d'%%0%d.%df\"%%c", + fract+2+(fract?1:0), fract); + dolong = con_w; + } +} + char * +rtodms(char *s, double r, int pos, int neg) { + int deg, min, sign; + char *ss = s; + double sec; + + if (r < 0) { + r = -r; + if (!pos) { *ss++ = '-'; sign = 0; } + else sign = neg; + } else + sign = pos; + r = floor(r * CONV + .5); + sec = fmod(r / RES, 60.); + r = floor(r / RES60); + min = fmod(r, 60.); + deg = r / 60.; + if (dolong) + (void)sprintf(ss,format,deg,min,sec,sign); + else if (sec) { + char *p, *q; + + (void)sprintf(ss,format,deg,min,sec,sign); + for (q = p = ss + strlen(ss) - (sign ? 3 : 2); *p == '0'; --p) ; + if (*p != '.') + ++p; + if (++q != p) + (void)strcpy(p, q); + } else if (min) + (void)sprintf(ss,"%dd%d'%c",deg,min,sign); + else + (void)sprintf(ss,"%dd%c",deg, sign); + return s; +} diff --git a/src/strtod.c b/src/strtod.c new file mode 100644 index 00000000..1a6b3e19 --- /dev/null +++ b/src/strtod.c @@ -0,0 +1,151 @@ +#ifndef lint +static const char SCCSID[]="@(#)strtod.c 4.5 93/12/03 GIE REL"; +#endif +/* THIS CODE HAS BEEN MODIFIED from the distribution made by the FSF. +** However, "licensing" and header information are retained. +*/ +/* Copyright (C) 1991, 1992 Free Software Foundation, Inc. +This file is part of the GNU C Library. + +The GNU C Library is free software; you can redistribute it and/or +modify it under the terms of the GNU Library General Public License as +published by the Free Software Foundation; either version 2 of the +License, or (at your option) any later version. + +The GNU C Library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Library General Public License for more details. + +You should have received a copy of the GNU Library General Public +License along with the GNU C Library; see the file COPYING.LIB. If +not, write to the Free Software Foundation, Inc., 675 Mass Ave, +Cambridge, MA 02139, USA. */ + +#include <errno.h> +#include <float.h> +#include <ctype.h> +#include <stdlib.h> +#include <string.h> +#include <math.h> +/* Convert NPTR to a double. If ENDPTR is not NULL, a pointer to the + character after the last one used in the number is put in *ENDPTR. */ +#ifdef DOS +typedef int wchar_t; +#ifndef NULL +#define NULL 0 +#endif +#endif + double +strtod(const char *nptr, char **endptr) { + const char *s; + short int sign; + /* The number so far. */ + double num; + int got_dot; /* Found a decimal point. */ + int got_digit; /* Seen any digits. */ + /* The exponent of the number. */ + long int exponent; + + if (nptr == NULL) { + errno = EINVAL; + goto noconv; + } + s = nptr; + /* Eat whitespace. */ + while (isspace(*s)) + ++s; + /* Get the sign. */ + sign = *s == '-' ? -1 : 1; + if (*s == '-' || *s == '+') + ++s; + num = 0.0; + got_dot = 0; + got_digit = 0; + exponent = 0; + for (; ; ++s) { + if (isdigit (*s)) { + got_digit = 1; + /* Make sure that multiplication by 10 will not overflow. */ + if (num > DBL_MAX * 0.1) + /* The value of the digit doesn't matter, since we have already + gotten as many digits as can be represented in a `double'. + This doesn't necessarily mean the result will overflow. + The exponent may reduce it to within range. + + We just need to record that there was another + digit so that we can multiply by 10 later. */ + ++exponent; + else + num = (num * 10.0) + (*s - '0'); + /* Keep track of the number of digits after the decimal point. + If we just divided by 10 here, we would lose precision. */ + if (got_dot) + --exponent; + } else if (!got_dot && (wchar_t) * s == '.') + /* Record that we have found the decimal point. */ + got_dot = 1; + else + /* Any other character terminates the number. */ + break; + } + if (!got_digit) + goto noconv; + if (tolower(*s) == 'e') { + /* Get the exponent specified after the `e' or `E'. */ + int save = errno; + char *end; + long int exp; + + errno = 0; + ++s; + exp = strtol(s, &end, 10); + if (errno == ERANGE) { + /* The exponent overflowed a `long int'. It is probably a safe + assumption that an exponent that cannot be represented by + a `long int' exceeds the limits of a `double'. */ + if (endptr != NULL) + *endptr = end; + if (exp < 0) + goto underflow; + else + goto overflow; + } else if (end == s) + /* There was no exponent. Reset END to point to + the 'e' or 'E', so *ENDPTR will be set there. */ + end = (char *) s - 1; + errno = save; + s = end; + exponent += exp; + } + if (endptr != NULL) + *endptr = (char *) s; + if (num == 0.0) + return 0.0; + /* Multiply NUM by 10 to the EXPONENT power, + checking for overflow and underflow. */ + if (exponent < 0) { + if (num < DBL_MIN * pow(10.0, (double) -exponent)) + goto underflow; + } else if (exponent > 0) { + if (num > DBL_MAX * pow(10.0, (double) -exponent)) + goto overflow; + } + num *= pow(10.0, (double) exponent); + return num * sign; +overflow: + /* Return an overflow error. */ + errno = ERANGE; + return HUGE_VAL * sign; +underflow: + /* Return an underflow error. */ + if (endptr != NULL) + *endptr = (char *) nptr; + errno = ERANGE; + return 0.0; +noconv: + /* There was no number. */ + if (endptr != NULL) + *endptr = (char *) nptr; + return 0.0; +} diff --git a/src/vector1.c b/src/vector1.c new file mode 100644 index 00000000..0ca3816b --- /dev/null +++ b/src/vector1.c @@ -0,0 +1,32 @@ +/* make storage for one and two dimensional matricies */ +#ifndef lint +static const char SCCSID[]="@(#)vector1.c 4.4 94/03/22 GIE REL"; +#endif +#include <stdlib.h> +#include <projects.h> + void * /* one dimension array */ +vector1(int nvals, int size) { return((void *)pj_malloc(size * nvals)); } + void /* free 2D array */ +freev2(void **v, int nrows) { + if (v) { + for (v += nrows; nrows > 0; --nrows) + pj_dalloc(*--v); + pj_dalloc(v); + } +} + void ** /* two dimension array */ +vector2(int nrows, int ncols, int size) { + void **s; + + if (s = (void **)pj_malloc(sizeof(void *) * nrows)) { + int rsize, i; + + rsize = size * ncols; + for (i = 0; i < nrows; ++i) + if (!(s[i] = pj_malloc(rsize))) { + freev2(s, i); + return (void **)0; + } + } + return s; +} |