1 /*============================================================================
2   WCSLIB 7.3 - an implementation of the FITS WCS standard.
3   Copyright (C) 1995-2020, Mark Calabretta
4 
5   This file is part of WCSLIB.
6 
7   WCSLIB is free software: you can redistribute it and/or modify it under the
8   terms of the GNU Lesser General Public License as published by the Free
9   Software Foundation, either version 3 of the License, or (at your option)
10   any later version.
11 
12   WCSLIB is distributed in the hope that it will be useful, but WITHOUT ANY
13   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14   FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for
15   more details.
16 
17   You should have received a copy of the GNU Lesser General Public License
18   along with WCSLIB.  If not, see http://www.gnu.org/licenses.
19 
20   Direct correspondence concerning WCSLIB to mark@calabretta.id.au
21 
22   Author: Mark Calabretta, Australia Telescope National Facility, CSIRO.
23   http://www.atnf.csiro.au/people/Mark.Calabretta
24   $Id: prj.c,v 7.3.1.2 2020/08/17 11:19:09 mcalabre Exp mcalabre $
25 *===========================================================================*/
26 
27 #include <math.h>
28 #include <stdio.h>
29 #include <stdlib.h>
30 #include <string.h>
31 
32 #include "wcserr.h"
33 #include "wcsmath.h"
34 #include "wcsprintf.h"
35 #include "wcstrig.h"
36 #include "wcsutil.h"
37 #include "prj.h"
38 
39 
40 // Projection categories.
41 const int ZENITHAL          = 1;
42 const int CYLINDRICAL       = 2;
43 const int PSEUDOCYLINDRICAL = 3;
44 const int CONVENTIONAL      = 4;
45 const int CONIC             = 5;
46 const int POLYCONIC         = 6;
47 const int QUADCUBE          = 7;
48 const int HEALPIX           = 8;
49 
50 const char prj_categories[9][32] =
51   {"undefined", "zenithal", "cylindrical", "pseudocylindrical",
52   "conventional", "conic", "polyconic", "quadcube", "HEALPix"};
53 
54 
55 // Projection codes.
56 const int  prj_ncode = 28;
57 const char prj_codes[28][4] =
58   {"AZP", "SZP", "TAN", "STG", "SIN", "ARC", "ZPN", "ZEA", "AIR", "CYP",
59    "CEA", "CAR", "MER", "COP", "COE", "COD", "COO", "SFL", "PAR", "MOL",
60    "AIT", "BON", "PCO", "TSC", "CSC", "QSC", "HPX", "XPH"};
61 
62 const int AZP = 101;
63 const int SZP = 102;
64 const int TAN = 103;
65 const int STG = 104;
66 const int SIN = 105;
67 const int ARC = 106;
68 const int ZPN = 107;
69 const int ZEA = 108;
70 const int AIR = 109;
71 const int CYP = 201;
72 const int CEA = 202;
73 const int CAR = 203;
74 const int MER = 204;
75 const int SFL = 301;
76 const int PAR = 302;
77 const int MOL = 303;
78 const int AIT = 401;
79 const int COP = 501;
80 const int COE = 502;
81 const int COD = 503;
82 const int COO = 504;
83 const int BON = 601;
84 const int PCO = 602;
85 const int TSC = 701;
86 const int CSC = 702;
87 const int QSC = 703;
88 const int HPX = 801;
89 const int XPH = 802;
90 
91 
92 // Map status return value to message.
93 const char *prj_errmsg[] = {
94   "Success",
95   "Null prjprm pointer passed",
96   "Invalid projection parameters",
97   "One or more of the (x,y) coordinates were invalid",
98   "One or more of the (phi,theta) coordinates were invalid"};
99 
100 // Convenience macros for generating common error messages.
101 #define PRJERR_BAD_PARAM_SET(function) \
102   wcserr_set(&(prj->err), PRJERR_BAD_PARAM, function, __FILE__, __LINE__, \
103     "Invalid parameters for %s projection", prj->name);
104 
105 #define PRJERR_BAD_PIX_SET(function) \
106   wcserr_set(&(prj->err), PRJERR_BAD_PIX, function, __FILE__, __LINE__, \
107     "One or more of the (x, y) coordinates were invalid for %s projection", \
108     prj->name);
109 
110 #define PRJERR_BAD_WORLD_SET(function) \
111   wcserr_set(&(prj->err), PRJERR_BAD_WORLD, function, __FILE__, __LINE__, \
112     "One or more of the (lat, lng) coordinates were invalid for " \
113     "%s projection", prj->name);
114 
115 #define copysign(X, Y) ((Y) < 0.0 ? -fabs(X) : fabs(X))
116 
117 
118 /*============================================================================
119 * Generic routines:
120 *
121 * prjini initializes a prjprm struct to default values.
122 *
123 * prjfree frees any memory that may have been allocated to store an error
124 *        message in the prjprm struct.
125 *
126 * prjprt prints the contents of a prjprm struct.
127 *
128 * prjbchk performs bounds checking on the native coordinates returned by the
129 *        *x2s() routines.
130 *
131 * prjset invokes the specific initialization routine based on the projection
132 *        code in the prjprm struct.
133 *
134 * prjx2s invokes the specific deprojection routine based on the pointer-to-
135 *        function stored in the prjprm struct.
136 *
137 * prjs2x invokes the specific projection routine based on the pointer-to-
138 *        function stored in the prjprm struct.
139 *
140 *---------------------------------------------------------------------------*/
141 
prjini(struct prjprm * prj)142 int prjini(struct prjprm *prj)
143 
144 {
145   register int k;
146 
147   if (prj == 0x0) return PRJERR_NULL_POINTER;
148 
149   prj->flag = 0;
150 
151   strcpy(prj->code, "   ");
152   prj->pv[0]  = 0.0;
153   prj->pv[1]  = UNDEFINED;
154   prj->pv[2]  = UNDEFINED;
155   prj->pv[3]  = UNDEFINED;
156   for (k = 4; k < PVN; prj->pv[k++] = 0.0);
157   prj->r0     = 0.0;
158   prj->phi0   = UNDEFINED;
159   prj->theta0 = UNDEFINED;
160   prj->bounds = 7;
161 
162   strcpy(prj->name, "undefined");
163   for (k = 9; k < 40; prj->name[k++] = '\0');
164   prj->category  = 0;
165   prj->pvrange   = 0;
166   prj->simplezen = 0;
167   prj->equiareal = 0;
168   prj->conformal = 0;
169   prj->global    = 0;
170   prj->divergent = 0;
171   prj->x0 = 0.0;
172   prj->y0 = 0.0;
173 
174   prj->err = 0x0;
175 
176   prj->padding = 0x0;
177   for (k = 0; k < 10; prj->w[k++] = 0.0);
178   prj->m = 0;
179   prj->n = 0;
180   prj->prjx2s = 0x0;
181   prj->prjs2x = 0x0;
182 
183   return 0;
184 }
185 
186 //----------------------------------------------------------------------------
187 
prjfree(struct prjprm * prj)188 int prjfree(struct prjprm *prj)
189 
190 {
191   if (prj == 0x0) return PRJERR_NULL_POINTER;
192 
193   wcserr_clear(&(prj->err));
194 
195   return 0;
196 }
197 
198 //----------------------------------------------------------------------------
199 
prjprt(const struct prjprm * prj)200 int prjprt(const struct prjprm *prj)
201 
202 {
203   char hext[32];
204   int  i, n;
205 
206   if (prj == 0x0) return PRJERR_NULL_POINTER;
207 
208   wcsprintf("       flag: %d\n",  prj->flag);
209   wcsprintf("       code: \"%s\"\n",  prj->code);
210   wcsprintf("         r0: %9f\n", prj->r0);
211   wcsprintf("         pv:");
212   if (prj->pvrange) {
213     n = (prj->pvrange)%100;
214 
215     if (prj->pvrange/100) {
216       wcsprintf(" (0)");
217     } else {
218       wcsprintf(" %#- 11.5g", prj->pv[0]);
219       n--;
220     }
221 
222     for (i = 1; i <= n; i++) {
223       if (i%5 == 1) {
224         wcsprintf("\n           ");
225       }
226 
227       if (undefined(prj->pv[i])) {
228         wcsprintf("  UNDEFINED   ");
229       } else {
230         wcsprintf("  %#- 11.5g", prj->pv[i]);
231       }
232     }
233     wcsprintf("\n");
234   } else {
235     wcsprintf(" (not used)\n");
236   }
237   if (undefined(prj->phi0)) {
238     wcsprintf("       phi0: UNDEFINED\n");
239   } else {
240     wcsprintf("       phi0: %9f\n", prj->phi0);
241   }
242   if (undefined(prj->theta0)) {
243     wcsprintf("     theta0: UNDEFINED\n");
244   } else {
245     wcsprintf("     theta0: %9f\n", prj->theta0);
246   }
247   wcsprintf("     bounds: %d\n",  prj->bounds);
248 
249   wcsprintf("\n");
250   wcsprintf("       name: \"%s\"\n", prj->name);
251   wcsprintf("   category: %d (%s)\n", prj->category,
252                                       prj_categories[prj->category]);
253   wcsprintf("    pvrange: %d\n", prj->pvrange);
254   wcsprintf("  simplezen: %d\n", prj->simplezen);
255   wcsprintf("  equiareal: %d\n", prj->equiareal);
256   wcsprintf("  conformal: %d\n", prj->conformal);
257   wcsprintf("     global: %d\n", prj->global);
258   wcsprintf("  divergent: %d\n", prj->divergent);
259   wcsprintf("         x0: %f\n", prj->x0);
260   wcsprintf("         y0: %f\n", prj->y0);
261 
262   WCSPRINTF_PTR("        err: ", prj->err, "\n");
263   if (prj->err) {
264     wcserr_prt(prj->err, "             ");
265   }
266 
267   wcsprintf("        w[]:");
268   for (i = 0; i < 5; i++) {
269     wcsprintf("  %#- 11.5g", prj->w[i]);
270   }
271   wcsprintf("\n            ");
272   for (i = 5; i < 10; i++) {
273     wcsprintf("  %#- 11.5g", prj->w[i]);
274   }
275   wcsprintf("\n");
276   wcsprintf("          m: %d\n", prj->m);
277   wcsprintf("          n: %d\n", prj->n);
278   wcsprintf("     prjx2s: %s\n",
279     wcsutil_fptr2str((void (*)(void))prj->prjx2s, hext));
280   wcsprintf("     prjs2x: %s\n",
281     wcsutil_fptr2str((void (*)(void))prj->prjs2x, hext));
282 
283   return 0;
284 }
285 
286 //----------------------------------------------------------------------------
287 
prjperr(const struct prjprm * prj,const char * prefix)288 int prjperr(const struct prjprm *prj, const char *prefix)
289 
290 {
291   if (prj == 0x0) return PRJERR_NULL_POINTER;
292 
293   if (prj->err) {
294     wcserr_prt(prj->err, prefix);
295   }
296 
297   return 0;
298 }
299 
300 //----------------------------------------------------------------------------
301 
prjbchk(double tol,int nphi,int ntheta,int spt,double phi[],double theta[],int stat[])302 int prjbchk(
303   double tol,
304   int nphi,
305   int ntheta,
306   int spt,
307   double phi[],
308   double theta[],
309   int stat[])
310 
311 {
312   int status = 0;
313   register int iphi, itheta, *statp;
314   register double *phip, *thetap;
315 
316   phip   = phi;
317   thetap = theta;
318   statp  = stat;
319   for (itheta = 0; itheta < ntheta; itheta++) {
320     for (iphi = 0; iphi < nphi; iphi++, phip += spt, thetap += spt, statp++) {
321       // Skip values already marked as illegal.
322       if (*statp == 0) {
323         if (*phip < -180.0) {
324           if (*phip < -180.0-tol) {
325             *statp = 1;
326             status = 1;
327           } else {
328             *phip = -180.0;
329           }
330         } else if (180.0 < *phip) {
331           if (180.0+tol < *phip) {
332             *statp = 1;
333             status = 1;
334           } else {
335             *phip = 180.0;
336           }
337         }
338 
339         if (*thetap < -90.0) {
340           if (*thetap < -90.0-tol) {
341             *statp = 1;
342             status = 1;
343           } else {
344             *thetap = -90.0;
345           }
346         } else if (90.0 < *thetap) {
347           if (90.0+tol < *thetap) {
348             *statp = 1;
349             status = 1;
350           } else {
351             *thetap = 90.0;
352           }
353         }
354       }
355     }
356   }
357 
358   return status;
359 }
360 
361 //----------------------------------------------------------------------------
362 
prjset(struct prjprm * prj)363 int prjset(struct prjprm *prj)
364 
365 {
366   static const char *function = "prjset";
367 
368   int status;
369   struct wcserr **err;
370 
371   if (prj == 0x0) return PRJERR_NULL_POINTER;
372   err = &(prj->err);
373 
374   // Invoke the relevant initialization routine.
375   prj->code[3] = '\0';
376   if (strcmp(prj->code, "AZP") == 0) {
377     status = azpset(prj);
378   } else if (strcmp(prj->code, "SZP") == 0) {
379     status = szpset(prj);
380   } else if (strcmp(prj->code, "TAN") == 0) {
381     status = tanset(prj);
382   } else if (strcmp(prj->code, "STG") == 0) {
383     status = stgset(prj);
384   } else if (strcmp(prj->code, "SIN") == 0) {
385     status = sinset(prj);
386   } else if (strcmp(prj->code, "ARC") == 0) {
387     status = arcset(prj);
388   } else if (strcmp(prj->code, "ZPN") == 0) {
389     status = zpnset(prj);
390   } else if (strcmp(prj->code, "ZEA") == 0) {
391     status = zeaset(prj);
392   } else if (strcmp(prj->code, "AIR") == 0) {
393     status = airset(prj);
394   } else if (strcmp(prj->code, "CYP") == 0) {
395     status = cypset(prj);
396   } else if (strcmp(prj->code, "CEA") == 0) {
397     status = ceaset(prj);
398   } else if (strcmp(prj->code, "CAR") == 0) {
399     status = carset(prj);
400   } else if (strcmp(prj->code, "MER") == 0) {
401     status = merset(prj);
402   } else if (strcmp(prj->code, "SFL") == 0) {
403     status = sflset(prj);
404   } else if (strcmp(prj->code, "PAR") == 0) {
405     status = parset(prj);
406   } else if (strcmp(prj->code, "MOL") == 0) {
407     status = molset(prj);
408   } else if (strcmp(prj->code, "AIT") == 0) {
409     status = aitset(prj);
410   } else if (strcmp(prj->code, "COP") == 0) {
411     status = copset(prj);
412   } else if (strcmp(prj->code, "COE") == 0) {
413     status = coeset(prj);
414   } else if (strcmp(prj->code, "COD") == 0) {
415     status = codset(prj);
416   } else if (strcmp(prj->code, "COO") == 0) {
417     status = cooset(prj);
418   } else if (strcmp(prj->code, "BON") == 0) {
419     status = bonset(prj);
420   } else if (strcmp(prj->code, "PCO") == 0) {
421     status = pcoset(prj);
422   } else if (strcmp(prj->code, "TSC") == 0) {
423     status = tscset(prj);
424   } else if (strcmp(prj->code, "CSC") == 0) {
425     status = cscset(prj);
426   } else if (strcmp(prj->code, "QSC") == 0) {
427     status = qscset(prj);
428   } else if (strcmp(prj->code, "HPX") == 0) {
429     status = hpxset(prj);
430   } else if (strcmp(prj->code, "XPH") == 0) {
431     status = xphset(prj);
432   } else {
433     // Unrecognized projection code.
434     status = wcserr_set(WCSERR_SET(PRJERR_BAD_PARAM),
435                "Unrecognized projection code '%s'", prj->code);
436   }
437 
438   return status;
439 }
440 
441 //----------------------------------------------------------------------------
442 
prjx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])443 int prjx2s(
444   struct prjprm *prj,
445   int nx,
446   int ny,
447   int sxy,
448   int spt,
449   const double x[],
450   const double y[],
451   double phi[],
452   double theta[],
453   int stat[])
454 
455 {
456   int status;
457 
458   // Initialize.
459   if (prj == 0x0) return PRJERR_NULL_POINTER;
460   if (prj->flag == 0) {
461     if ((status = prjset(prj))) return status;
462   }
463 
464   return prj->prjx2s(prj, nx, ny, sxy, spt, x, y, phi, theta, stat);
465 }
466 
467 //----------------------------------------------------------------------------
468 
prjs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])469 int prjs2x(
470   struct prjprm *prj,
471   int nphi,
472   int ntheta,
473   int spt,
474   int sxy,
475   const double phi[],
476   const double theta[],
477   double x[],
478   double y[],
479   int stat[])
480 
481 {
482   int status;
483 
484   // Initialize.
485   if (prj == 0x0) return PRJERR_NULL_POINTER;
486   if (prj->flag == 0) {
487     if ((status = prjset(prj))) return status;
488   }
489 
490   return prj->prjs2x(prj, nphi, ntheta, spt, sxy, phi, theta, x, y, stat);
491 }
492 
493 /*============================================================================
494 * Internal helper routine used by the *set() routines - not intended for
495 * outside use.  It forces (x,y) = (0,0) at (phi0,theta0).
496 *---------------------------------------------------------------------------*/
497 
prjoff(struct prjprm * prj,const double phi0,const double theta0)498 int prjoff(
499   struct prjprm *prj,
500   const double phi0,
501   const double theta0)
502 
503 {
504   int    stat;
505   double x0, y0;
506 
507   if (prj == 0x0) return PRJERR_NULL_POINTER;
508 
509   prj->x0 = 0.0;
510   prj->y0 = 0.0;
511 
512   if (undefined(prj->phi0) || undefined(prj->theta0)) {
513     // Set both to the projection-specific default if either undefined.
514     prj->phi0   = phi0;
515     prj->theta0 = theta0;
516 
517   } else {
518     if (prj->prjs2x(prj, 1, 1, 1, 1, &(prj->phi0), &(prj->theta0), &x0, &y0,
519                     &stat)) {
520       return PRJERR_BAD_PARAM_SET("prjoff");
521     }
522 
523     prj->x0 = x0;
524     prj->y0 = y0;
525   }
526 
527   return 0;
528 }
529 
530 /*============================================================================
531 *   AZP: zenithal/azimuthal perspective projection.
532 *
533 *   Given:
534 *      prj->pv[1]   Distance parameter, mu in units of r0.
535 *      prj->pv[2]   Tilt angle, gamma in degrees.
536 *
537 *   Given and/or returned:
538 *      prj->r0      Reset to 180/pi if 0.
539 *      prj->phi0    Reset to  0.0 if undefined.
540 *      prj->theta0  Reset to 90.0 if undefined.
541 *
542 *   Returned:
543 *      prj->flag     AZP
544 *      prj->code    "AZP"
545 *      prj->x0      Offset in x.
546 *      prj->y0      Offset in y.
547 *      prj->w[0]    r0*(mu+1)
548 *      prj->w[1]    tan(gamma)
549 *      prj->w[2]    sec(gamma)
550 *      prj->w[3]    cos(gamma)
551 *      prj->w[4]    sin(gamma)
552 *      prj->w[5]    asin(-1/mu) for |mu| >= 1, -90 otherwise
553 *      prj->w[6]    mu*cos(gamma)
554 *      prj->w[7]    1 if |mu*cos(gamma)| < 1, 0 otherwise
555 *      prj->prjx2s  Pointer to azpx2s().
556 *      prj->prjs2x  Pointer to azps2x().
557 *===========================================================================*/
558 
azpset(struct prjprm * prj)559 int azpset(struct prjprm *prj)
560 
561 {
562   if (prj == 0x0) return PRJERR_NULL_POINTER;
563 
564   prj->flag = AZP;
565   strcpy(prj->code, "AZP");
566 
567   if (undefined(prj->pv[1])) prj->pv[1] = 0.0;
568   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
569   if (prj->r0 == 0.0) prj->r0 = R2D;
570 
571   strcpy(prj->name, "zenithal/azimuthal perspective");
572   prj->category  = ZENITHAL;
573   prj->pvrange   = 102;
574   prj->simplezen = prj->pv[2] == 0.0;
575   prj->equiareal = 0;
576   prj->conformal = 0;
577   prj->global    = 0;
578   prj->divergent = prj->pv[1] <= 1.0;
579 
580   prj->w[0] = prj->r0*(prj->pv[1] + 1.0);
581   if (prj->w[0] == 0.0) {
582     return PRJERR_BAD_PARAM_SET("azpset");
583   }
584 
585   prj->w[3] = cosd(prj->pv[2]);
586   if (prj->w[3] == 0.0) {
587     return PRJERR_BAD_PARAM_SET("azpset");
588   }
589 
590   prj->w[2] = 1.0/prj->w[3];
591   prj->w[4] = sind(prj->pv[2]);
592   prj->w[1] = prj->w[4] / prj->w[3];
593 
594   if (fabs(prj->pv[1]) > 1.0) {
595     prj->w[5] = asind(-1.0/prj->pv[1]);
596   } else {
597     prj->w[5] = -90.0;
598   }
599 
600   prj->w[6] = prj->pv[1] * prj->w[3];
601   prj->w[7] = (fabs(prj->w[6]) < 1.0) ? 1.0 : 0.0;
602 
603   prj->prjx2s = azpx2s;
604   prj->prjs2x = azps2x;
605 
606   return prjoff(prj, 0.0, 90.0);
607 }
608 
609 //----------------------------------------------------------------------------
610 
azpx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])611 int azpx2s(
612   struct prjprm *prj,
613   int nx,
614   int ny,
615   int sxy,
616   int spt,
617   const double x[],
618   const double y[],
619   double phi[],
620   double theta[],
621   int stat[])
622 
623 {
624   int mx, my, rowlen, rowoff, status;
625   double a, b, q, r, s, t, xj, yj, yc, yc2;
626   const double tol = 1.0e-13;
627   register int ix, iy, *statp;
628   register const double *xp, *yp;
629   register double *phip, *thetap;
630 
631 
632   // Initialize.
633   if (prj == 0x0) return PRJERR_NULL_POINTER;
634   if (prj->flag != AZP) {
635     if ((status = azpset(prj))) return status;
636   }
637 
638   if (ny > 0) {
639     mx = nx;
640     my = ny;
641   } else {
642     mx = 1;
643     my = 1;
644     ny = nx;
645   }
646 
647   status = 0;
648 
649 
650   // Do x dependence.
651   xp = x;
652   rowoff = 0;
653   rowlen = nx*spt;
654   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
655     xj = *xp + prj->x0;
656 
657     phip = phi + rowoff;
658     for (iy = 0; iy < my; iy++) {
659       *phip = xj;
660       phip += rowlen;
661     }
662   }
663 
664 
665   // Do y dependence.
666   yp = y;
667   phip   = phi;
668   thetap = theta;
669   statp  = stat;
670   for (iy = 0; iy < ny; iy++, yp += sxy) {
671     yj = *yp + prj->y0;
672 
673     yc  = yj*prj->w[3];
674     yc2 = yc*yc;
675 
676     q = prj->w[0] + yj*prj->w[4];
677 
678     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
679       xj = *phip;
680 
681       r = sqrt(xj*xj + yc2);
682       if (r == 0.0) {
683         *phip = 0.0;
684         *thetap = 90.0;
685         *(statp++) = 0;
686 
687       } else {
688         *phip = atan2d(xj, -yc);
689 
690         s = r / q;
691         t = s*prj->pv[1]/sqrt(s*s + 1.0);
692 
693         s = atan2d(1.0, s);
694 
695         if (fabs(t) > 1.0) {
696           if (fabs(t) > 1.0+tol) {
697             *thetap = 0.0;
698             *(statp++) = 1;
699             if (!status) status = PRJERR_BAD_PIX_SET("azpx2s");
700             continue;
701           }
702           t = copysign(90.0, t);
703         } else {
704           t = asind(t);
705         }
706 
707         a = s - t;
708         b = s + t + 180.0;
709 
710         if (a > 90.0) a -= 360.0;
711         if (b > 90.0) b -= 360.0;
712 
713         *thetap = (a > b) ? a : b;
714         *(statp++) = 0;
715       }
716     }
717   }
718 
719 
720   // Do bounds checking on the native coordinates.
721   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
722     if (!status) status = PRJERR_BAD_PIX_SET("azpx2s");
723   }
724 
725   return status;
726 }
727 
728 //----------------------------------------------------------------------------
729 
azps2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])730 int azps2x(
731   struct prjprm *prj,
732   int nphi,
733   int ntheta,
734   int spt,
735   int sxy,
736   const double phi[],
737   const double theta[],
738   double x[],
739   double y[],
740   int stat[])
741 
742 {
743   int mphi, mtheta, rowlen, rowoff, status;
744   double a, b, cosphi, costhe, r, s, sinphi, sinthe, t;
745   register int iphi, itheta, istat, *statp;
746   register const double *phip, *thetap;
747   register double *xp, *yp;
748 
749 
750   // Initialize.
751   if (prj == 0x0) return PRJERR_NULL_POINTER;
752   if (prj->flag != AZP) {
753     if ((status = azpset(prj))) return status;
754   }
755 
756   if (ntheta > 0) {
757     mphi   = nphi;
758     mtheta = ntheta;
759   } else {
760     mphi   = 1;
761     mtheta = 1;
762     ntheta = nphi;
763   }
764 
765   status = 0;
766 
767 
768   // Do phi dependence.
769   phip = phi;
770   rowoff = 0;
771   rowlen = nphi*sxy;
772   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
773     sincosd(*phip, &sinphi, &cosphi);
774 
775     xp = x + rowoff;
776     yp = y + rowoff;
777     for (itheta = 0; itheta < mtheta; itheta++) {
778       *xp = sinphi;
779       *yp = cosphi;
780       xp += rowlen;
781       yp += rowlen;
782     }
783   }
784 
785 
786   // Do theta dependence.
787   thetap = theta;
788   xp = x;
789   yp = y;
790   statp = stat;
791   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
792     sincosd(*thetap, &sinthe, &costhe);
793 
794     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
795       s = prj->w[1]*(*yp);
796       t = (prj->pv[1] + sinthe) + costhe*s;
797 
798       if (t == 0.0) {
799         *xp = 0.0;
800         *yp = 0.0;
801         *(statp++) = 1;
802         if (!status) status = PRJERR_BAD_WORLD_SET("azps2x");
803 
804       } else {
805         r = prj->w[0]*costhe/t;
806 
807         // Bounds checking.
808         istat = 0;
809         if (prj->bounds&1) {
810           if (*thetap < prj->w[5]) {
811             // Overlap.
812             istat = 1;
813             if (!status) status = PRJERR_BAD_WORLD_SET("azps2x");
814 
815           } else if (prj->w[7] > 0.0) {
816             // Divergence.
817             t = prj->pv[1] / sqrt(1.0 + s*s);
818 
819             if (fabs(t) <= 1.0) {
820               s = atand(-s);
821               t = asind(t);
822               a = s - t;
823               b = s + t + 180.0;
824 
825               if (a > 90.0) a -= 360.0;
826               if (b > 90.0) b -= 360.0;
827 
828               if (*thetap < ((a > b) ? a : b)) {
829                 istat = 1;
830                 if (!status) status = PRJERR_BAD_WORLD_SET("azps2x");
831               }
832             }
833           }
834         }
835 
836         *xp =  r*(*xp) - prj->x0;
837         *yp = -r*(*yp)*prj->w[2] - prj->y0;
838         *(statp++) = istat;
839       }
840     }
841   }
842 
843   return status;
844 }
845 
846 /*============================================================================
847 *   SZP: slant zenithal perspective projection.
848 *
849 *   Given:
850 *      prj->pv[1]   Distance of the point of projection from the centre of the
851 *                   generating sphere, mu in units of r0.
852 *      prj->pv[2]   Native longitude, phi_c, and ...
853 *      prj->pv[3]   Native latitude, theta_c, on the planewards side of the
854 *                   intersection of the line through the point of projection
855 *                   and the centre of the generating sphere, phi_c in degrees.
856 *
857 *   Given and/or returned:
858 *      prj->r0      Reset to 180/pi if 0.
859 *      prj->phi0    Reset to  0.0 if undefined.
860 *      prj->theta0  Reset to 90.0 if undefined.
861 *
862 *   Returned:
863 *      prj->flag     SZP
864 *      prj->code    "SZP"
865 *      prj->x0      Fiducial offset in x.
866 *      prj->y0      Fiducial offset in y.
867 *      prj->w[0]    1/r0
868 *      prj->w[1]    xp = -mu*cos(theta_c)*sin(phi_c)
869 *      prj->w[2]    yp =  mu*cos(theta_c)*cos(phi_c)
870 *      prj->w[3]    zp =  mu*sin(theta_c) + 1
871 *      prj->w[4]    r0*xp
872 *      prj->w[5]    r0*yp
873 *      prj->w[6]    r0*zp
874 *      prj->w[7]    (zp - 1)^2
875 *      prj->w[8]    asin(1-zp) if |1 - zp| < 1, -90 otherwise
876 *      prj->prjx2s  Pointer to szpx2s().
877 *      prj->prjs2x  Pointer to szps2x().
878 *===========================================================================*/
879 
szpset(struct prjprm * prj)880 int szpset(struct prjprm *prj)
881 
882 {
883   if (prj == 0x0) return PRJERR_NULL_POINTER;
884 
885   prj->flag = SZP;
886   strcpy(prj->code, "SZP");
887 
888   if (undefined(prj->pv[1])) prj->pv[1] =  0.0;
889   if (undefined(prj->pv[2])) prj->pv[2] =  0.0;
890   if (undefined(prj->pv[3])) prj->pv[3] = 90.0;
891   if (prj->r0 == 0.0) prj->r0 = R2D;
892 
893   strcpy(prj->name, "slant zenithal perspective");
894   prj->category  = ZENITHAL;
895   prj->pvrange   = 103;
896   prj->simplezen = prj->pv[3] == 90.0;
897   prj->equiareal = 0;
898   prj->conformal = 0;
899   prj->global    = 0;
900   prj->divergent = prj->pv[1] <= 1.0;
901 
902   prj->w[0] = 1.0/prj->r0;
903 
904   prj->w[3] = prj->pv[1] * sind(prj->pv[3]) + 1.0;
905   if (prj->w[3] == 0.0) {
906     return PRJERR_BAD_PARAM_SET("szpset");
907   }
908 
909   prj->w[1] = -prj->pv[1] * cosd(prj->pv[3]) * sind(prj->pv[2]);
910   prj->w[2] =  prj->pv[1] * cosd(prj->pv[3]) * cosd(prj->pv[2]);
911   prj->w[4] =  prj->r0 * prj->w[1];
912   prj->w[5] =  prj->r0 * prj->w[2];
913   prj->w[6] =  prj->r0 * prj->w[3];
914   prj->w[7] =  (prj->w[3] - 1.0) * prj->w[3] - 1.0;
915 
916   if (fabs(prj->w[3] - 1.0) < 1.0) {
917     prj->w[8] = asind(1.0 - prj->w[3]);
918   } else {
919     prj->w[8] = -90.0;
920   }
921 
922   prj->prjx2s = szpx2s;
923   prj->prjs2x = szps2x;
924 
925   return prjoff(prj, 0.0, 90.0);
926 }
927 
928 //----------------------------------------------------------------------------
929 
szpx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])930 int szpx2s(
931   struct prjprm *prj,
932   int nx,
933   int ny,
934   int sxy,
935   int spt,
936   const double x[],
937   const double y[],
938   double phi[],
939   double theta[],
940   int stat[])
941 
942 {
943   int mx, my, rowlen, rowoff, status;
944   double a, b, c, d, r2, sinth1, sinth2, sinthe, t, x1, xr, xy, y1, yr, z;
945   const double tol = 1.0e-13;
946   register int ix, iy, *statp;
947   register const double *xp, *yp;
948   register double *phip, *thetap;
949 
950 
951   // Initialize.
952   if (prj == 0x0) return PRJERR_NULL_POINTER;
953   if (prj->flag != SZP) {
954     if ((status = szpset(prj))) return status;
955   }
956 
957   if (ny > 0) {
958     mx = nx;
959     my = ny;
960   } else {
961     mx = 1;
962     my = 1;
963     ny = nx;
964   }
965 
966   status = 0;
967 
968 
969   // Do x dependence.
970   xp = x;
971   rowoff = 0;
972   rowlen = nx*spt;
973   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
974     xr = (*xp + prj->x0)*prj->w[0];
975 
976     phip = phi + rowoff;
977     for (iy = 0; iy < my; iy++) {
978       *phip = xr;
979       phip += rowlen;
980     }
981   }
982 
983 
984   // Do y dependence.
985   yp = y;
986   phip   = phi;
987   thetap = theta;
988   statp  = stat;
989   for (iy = 0; iy < ny; iy++, yp += sxy) {
990     yr = (*yp + prj->y0)*prj->w[0];
991 
992     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
993       xr = *phip;
994       r2 = xr*xr + yr*yr;
995 
996       x1 = (xr - prj->w[1])/prj->w[3];
997       y1 = (yr - prj->w[2])/prj->w[3];
998       xy = xr*x1 + yr*y1;
999 
1000       if (r2 < 1.0e-10) {
1001         // Use small angle formula.
1002         z = r2/2.0;
1003         *thetap = 90.0 - R2D*sqrt(r2/(1.0 + xy));
1004 
1005       } else {
1006         t = x1*x1 + y1*y1;
1007         a = t + 1.0;
1008         b = xy - t;
1009         c = r2 - xy - xy + t - 1.0;
1010         d = b*b - a*c;
1011 
1012         // Check for a solution.
1013         if (d < 0.0) {
1014           *phip = 0.0;
1015           *thetap = 0.0;
1016           *(statp++) = 1;
1017           if (!status) status = PRJERR_BAD_PIX_SET("szpx2s");
1018           continue;
1019         }
1020         d = sqrt(d);
1021 
1022         // Choose solution closest to pole.
1023         sinth1 = (-b + d)/a;
1024         sinth2 = (-b - d)/a;
1025         sinthe = (sinth1 > sinth2) ? sinth1 : sinth2;
1026         if (sinthe > 1.0) {
1027           if (sinthe-1.0 < tol) {
1028             sinthe = 1.0;
1029           } else {
1030             sinthe = (sinth1 < sinth2) ? sinth1 : sinth2;
1031           }
1032         }
1033 
1034         if (sinthe < -1.0) {
1035           if (sinthe+1.0 > -tol) {
1036             sinthe = -1.0;
1037           }
1038         }
1039 
1040         if (sinthe > 1.0 || sinthe < -1.0) {
1041           *phip   = 0.0;
1042           *thetap = 0.0;
1043           *(statp++) = 1;
1044           if (!status) status = PRJERR_BAD_PIX_SET("szpx2s");
1045           continue;
1046         }
1047 
1048         *thetap = asind(sinthe);
1049 
1050         z = 1.0 - sinthe;
1051       }
1052 
1053       *phip = atan2d(xr - x1*z, -(yr - y1*z));
1054       *(statp++) = 0;
1055     }
1056   }
1057 
1058 
1059   // Do bounds checking on the native coordinates.
1060   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
1061     if (!status) status = PRJERR_BAD_PIX_SET("szpx2s");
1062   }
1063 
1064   return status;
1065 }
1066 
1067 //----------------------------------------------------------------------------
1068 
szps2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])1069 int szps2x(
1070   struct prjprm *prj,
1071   int nphi,
1072   int ntheta,
1073   int spt,
1074   int sxy,
1075   const double phi[],
1076   const double theta[],
1077   double x[],
1078   double y[],
1079   int stat[])
1080 
1081 {
1082   int mphi, mtheta, rowlen, rowoff, status;
1083   double a, b, cosphi, r, s, sinphi, t, u, v;
1084   register int iphi, itheta, istat, *statp;
1085   register const double *phip, *thetap;
1086   register double *xp, *yp;
1087 
1088 
1089   // Initialize.
1090   if (prj == 0x0) return PRJERR_NULL_POINTER;
1091   if (prj->flag != SZP) {
1092     if ((status = szpset(prj))) return status;
1093   }
1094 
1095   if (ntheta > 0) {
1096     mphi   = nphi;
1097     mtheta = ntheta;
1098   } else {
1099     mphi   = 1;
1100     mtheta = 1;
1101     ntheta = nphi;
1102   }
1103 
1104   status = 0;
1105 
1106 
1107   // Do phi dependence.
1108   phip = phi;
1109   rowoff = 0;
1110   rowlen = nphi*sxy;
1111   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
1112     sincosd(*phip, &sinphi, &cosphi);
1113 
1114     xp = x + rowoff;
1115     yp = y + rowoff;
1116     for (itheta = 0; itheta < mtheta; itheta++) {
1117       *xp = sinphi;
1118       *yp = cosphi;
1119       xp += rowlen;
1120       yp += rowlen;
1121     }
1122   }
1123 
1124 
1125   // Do theta dependence.
1126   thetap = theta;
1127   xp = x;
1128   yp = y;
1129   statp = stat;
1130   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
1131     s = 1.0 - sind(*thetap);
1132     t = prj->w[3] - s;
1133 
1134     if (t == 0.0) {
1135       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1136         *xp = 0.0;
1137         *yp = 0.0;
1138         *(statp++) = 1;
1139       }
1140 
1141       if (!status) status = PRJERR_BAD_WORLD_SET("szps2x");
1142 
1143     } else {
1144       r = prj->w[6]*cosd(*thetap)/t;
1145       u = prj->w[4]*s/t + prj->x0;
1146       v = prj->w[5]*s/t + prj->y0;
1147 
1148       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1149         // Bounds checking.
1150         istat = 0;
1151         if (prj->bounds&1) {
1152           if (*thetap < prj->w[8]) {
1153             // Divergence.
1154             istat = 1;
1155             if (!status) status = PRJERR_BAD_WORLD_SET("szps2x");
1156 
1157           } else if (fabs(prj->pv[1]) > 1.0) {
1158             // Overlap.
1159             s = prj->w[1]*(*xp) - prj->w[2]*(*yp);
1160             t = 1.0/sqrt(prj->w[7] + s*s);
1161 
1162             if (fabs(t) <= 1.0) {
1163               s = atan2d(s, prj->w[3] - 1.0);
1164               t = asind(t);
1165               a = s - t;
1166               b = s + t + 180.0;
1167 
1168               if (a > 90.0) a -= 360.0;
1169               if (b > 90.0) b -= 360.0;
1170 
1171               if (*thetap < ((a > b) ? a : b)) {
1172                 istat = 1;
1173                 if (!status) status = PRJERR_BAD_WORLD_SET("szps2x");
1174               }
1175             }
1176           }
1177         }
1178 
1179         *xp =  r*(*xp) - u;
1180         *yp = -r*(*yp) - v;
1181         *(statp++) = istat;
1182       }
1183     }
1184   }
1185 
1186   return status;
1187 }
1188 
1189 
1190 /*============================================================================
1191 *   TAN: gnomonic projection.
1192 *
1193 *   Given and/or returned:
1194 *      prj->r0      Reset to 180/pi if 0.
1195 *      prj->phi0    Reset to  0.0 if undefined.
1196 *      prj->theta0  Reset to 90.0 if undefined.
1197 *
1198 *   Returned:
1199 *      prj->flag     TAN
1200 *      prj->code    "TAN"
1201 *      prj->x0      Fiducial offset in x.
1202 *      prj->y0      Fiducial offset in y.
1203 *      prj->prjx2s  Pointer to tanx2s().
1204 *      prj->prjs2x  Pointer to tans2x().
1205 *===========================================================================*/
1206 
tanset(struct prjprm * prj)1207 int tanset(struct prjprm *prj)
1208 
1209 {
1210   if (prj == 0x0) return PRJERR_NULL_POINTER;
1211 
1212   prj->flag = TAN;
1213   strcpy(prj->code, "TAN");
1214 
1215   if (prj->r0 == 0.0) prj->r0 = R2D;
1216 
1217   strcpy(prj->name, "gnomonic");
1218   prj->category  = ZENITHAL;
1219   prj->pvrange   = 0;
1220   prj->simplezen = 1;
1221   prj->equiareal = 0;
1222   prj->conformal = 0;
1223   prj->global    = 0;
1224   prj->divergent = 1;
1225 
1226   prj->prjx2s = tanx2s;
1227   prj->prjs2x = tans2x;
1228 
1229   return prjoff(prj, 0.0, 90.0);
1230 }
1231 
1232 //----------------------------------------------------------------------------
1233 
tanx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])1234 int tanx2s(
1235   struct prjprm *prj,
1236   int nx,
1237   int ny,
1238   int sxy,
1239   int spt,
1240   const double x[],
1241   const double y[],
1242   double phi[],
1243   double theta[],
1244   int stat[])
1245 
1246 {
1247   int mx, my, rowlen, rowoff, status;
1248   double r, xj, yj, yj2;
1249   register int ix, iy, *statp;
1250   register const double *xp, *yp;
1251   register double *phip, *thetap;
1252 
1253 
1254   // Initialize.
1255   if (prj == 0x0) return PRJERR_NULL_POINTER;
1256   if (prj->flag != TAN) {
1257     if ((status = tanset(prj))) return status;
1258   }
1259 
1260   if (ny > 0) {
1261     mx = nx;
1262     my = ny;
1263   } else {
1264     mx = 1;
1265     my = 1;
1266     ny = nx;
1267   }
1268 
1269   status = 0;
1270 
1271 
1272   // Do x dependence.
1273   xp = x;
1274   rowoff = 0;
1275   rowlen = nx*spt;
1276   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
1277     xj = *xp + prj->x0;
1278 
1279     phip = phi + rowoff;
1280     for (iy = 0; iy < my; iy++) {
1281       *phip = xj;
1282       phip += rowlen;
1283     }
1284   }
1285 
1286 
1287   // Do y dependence.
1288   yp = y;
1289   phip   = phi;
1290   thetap = theta;
1291   statp  = stat;
1292   for (iy = 0; iy < ny; iy++, yp += sxy) {
1293     yj  = *yp + prj->y0;
1294     yj2 = yj*yj;
1295 
1296     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
1297       xj = *phip;
1298 
1299       r = sqrt(xj*xj + yj2);
1300       if (r == 0.0) {
1301         *phip = 0.0;
1302       } else {
1303         *phip = atan2d(xj, -yj);
1304       }
1305 
1306       *thetap = atan2d(prj->r0, r);
1307       *(statp++) = 0;
1308     }
1309   }
1310 
1311 
1312   // Do bounds checking on the native coordinates.
1313   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
1314     if (!status) status = PRJERR_BAD_PIX_SET("tanx2s");
1315   }
1316 
1317   return status;
1318 }
1319 
1320 //----------------------------------------------------------------------------
1321 
tans2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])1322 int tans2x(
1323   struct prjprm *prj,
1324   int nphi,
1325   int ntheta,
1326   int spt,
1327   int sxy,
1328   const double phi[],
1329   const double theta[],
1330   double x[],
1331   double y[],
1332   int stat[])
1333 
1334 {
1335   int mphi, mtheta, rowlen, rowoff, status;
1336   double cosphi, r, s, sinphi;
1337   register int iphi, itheta, istat, *statp;
1338   register const double *phip, *thetap;
1339   register double *xp, *yp;
1340 
1341 
1342   // Initialize.
1343   if (prj == 0x0) return PRJERR_NULL_POINTER;
1344   if (prj->flag != TAN) {
1345     if ((status = tanset(prj))) return status;
1346   }
1347 
1348   if (ntheta > 0) {
1349     mphi   = nphi;
1350     mtheta = ntheta;
1351   } else {
1352     mphi   = 1;
1353     mtheta = 1;
1354     ntheta = nphi;
1355   }
1356 
1357   status = 0;
1358 
1359 
1360   // Do phi dependence.
1361   phip = phi;
1362   rowoff = 0;
1363   rowlen = nphi*sxy;
1364   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
1365     sincosd(*phip, &sinphi, &cosphi);
1366 
1367     xp = x + rowoff;
1368     yp = y + rowoff;
1369     for (itheta = 0; itheta < mtheta; itheta++) {
1370       *xp = sinphi;
1371       *yp = cosphi;
1372       xp += rowlen;
1373       yp += rowlen;
1374     }
1375   }
1376 
1377 
1378   // Do theta dependence.
1379   thetap = theta;
1380   xp = x;
1381   yp = y;
1382   statp = stat;
1383   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
1384     s = sind(*thetap);
1385     if (s == 0.0) {
1386       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1387         *xp = 0.0;
1388         *yp = 0.0;
1389         *(statp++) = 1;
1390       }
1391       if (!status) status = PRJERR_BAD_WORLD_SET("tans2x");
1392 
1393     } else {
1394       r =  prj->r0*cosd(*thetap)/s;
1395 
1396       // Bounds checking.
1397       istat = 0;
1398       if (prj->bounds&1) {
1399         if (s < 0.0) {
1400           istat = 1;
1401           if (!status) status = PRJERR_BAD_WORLD_SET("tans2x");
1402         }
1403       }
1404 
1405       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1406         *xp =  r*(*xp) - prj->x0;
1407         *yp = -r*(*yp) - prj->y0;
1408         *(statp++) = istat;
1409       }
1410     }
1411   }
1412 
1413   return status;
1414 }
1415 
1416 /*============================================================================
1417 *   STG: stereographic projection.
1418 *
1419 *   Given and/or returned:
1420 *      prj->r0      Reset to 180/pi if 0.
1421 *      prj->phi0    Reset to  0.0 if undefined.
1422 *      prj->theta0  Reset to 90.0 if undefined.
1423 *
1424 *   Returned:
1425 *      prj->flag     STG
1426 *      prj->code    "STG"
1427 *      prj->x0      Fiducial offset in x.
1428 *      prj->y0      Fiducial offset in y.
1429 *      prj->w[0]    2*r0
1430 *      prj->w[1]    1/(2*r0)
1431 *      prj->prjx2s  Pointer to stgx2s().
1432 *      prj->prjs2x  Pointer to stgs2x().
1433 *===========================================================================*/
1434 
stgset(struct prjprm * prj)1435 int stgset(struct prjprm *prj)
1436 
1437 {
1438   if (prj == 0x0) return PRJERR_NULL_POINTER;
1439 
1440   prj->flag = STG;
1441   strcpy(prj->code, "STG");
1442 
1443   strcpy(prj->name, "stereographic");
1444   prj->category  = ZENITHAL;
1445   prj->pvrange   = 0;
1446   prj->simplezen = 1;
1447   prj->equiareal = 0;
1448   prj->conformal = 1;
1449   prj->global    = 0;
1450   prj->divergent = 1;
1451 
1452   if (prj->r0 == 0.0) {
1453     prj->r0 = R2D;
1454     prj->w[0] = 360.0/PI;
1455     prj->w[1] = PI/360.0;
1456   } else {
1457     prj->w[0] = 2.0*prj->r0;
1458     prj->w[1] = 1.0/prj->w[0];
1459   }
1460 
1461   prj->prjx2s = stgx2s;
1462   prj->prjs2x = stgs2x;
1463 
1464   return prjoff(prj, 0.0, 90.0);
1465 }
1466 
1467 //----------------------------------------------------------------------------
1468 
stgx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])1469 int stgx2s(
1470   struct prjprm *prj,
1471   int nx,
1472   int ny,
1473   int sxy,
1474   int spt,
1475   const double x[],
1476   const double y[],
1477   double phi[],
1478   double theta[],
1479   int stat[])
1480 
1481 {
1482   int mx, my, rowlen, rowoff, status;
1483   double r, xj, yj, yj2;
1484   register int ix, iy, *statp;
1485   register const double *xp, *yp;
1486   register double *phip, *thetap;
1487 
1488 
1489   // Initialize.
1490   if (prj == 0x0) return PRJERR_NULL_POINTER;
1491   if (prj->flag != STG) {
1492     if ((status = stgset(prj))) return status;
1493   }
1494 
1495   if (ny > 0) {
1496     mx = nx;
1497     my = ny;
1498   } else {
1499     mx = 1;
1500     my = 1;
1501     ny = nx;
1502   }
1503 
1504 
1505   // Do x dependence.
1506   xp = x;
1507   rowoff = 0;
1508   rowlen = nx*spt;
1509   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
1510     xj = *xp + prj->x0;
1511 
1512     phip = phi + rowoff;
1513     for (iy = 0; iy < my; iy++) {
1514       *phip = xj;
1515       phip += rowlen;
1516     }
1517   }
1518 
1519 
1520   // Do y dependence.
1521   yp = y;
1522   phip   = phi;
1523   thetap = theta;
1524   statp  = stat;
1525   for (iy = 0; iy < ny; iy++, yp += sxy) {
1526     yj  = *yp + prj->y0;
1527     yj2 = yj*yj;
1528 
1529     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
1530       xj  = *phip;
1531 
1532       r = sqrt(xj*xj + yj2);
1533       if (r == 0.0) {
1534         *phip = 0.0;
1535       } else {
1536         *phip = atan2d(xj, -yj);
1537       }
1538 
1539       *thetap = 90.0 - 2.0*atand(r*prj->w[1]);
1540       *(statp++) = 0;
1541     }
1542   }
1543 
1544   return 0;
1545 }
1546 
1547 //----------------------------------------------------------------------------
1548 
stgs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])1549 int stgs2x(
1550   struct prjprm *prj,
1551   int nphi,
1552   int ntheta,
1553   int spt,
1554   int sxy,
1555   const double phi[],
1556   const double theta[],
1557   double x[],
1558   double y[],
1559   int stat[])
1560 
1561 {
1562   int mphi, mtheta, rowlen, rowoff, status;
1563   double cosphi, r, s, sinphi;
1564   register int iphi, itheta, *statp;
1565   register const double *phip, *thetap;
1566   register double *xp, *yp;
1567 
1568 
1569   // Initialize.
1570   if (prj == 0x0) return PRJERR_NULL_POINTER;
1571   if (prj->flag != STG) {
1572     if ((status = stgset(prj))) return status;
1573   }
1574 
1575   if (ntheta > 0) {
1576     mphi   = nphi;
1577     mtheta = ntheta;
1578   } else {
1579     mphi   = 1;
1580     mtheta = 1;
1581     ntheta = nphi;
1582   }
1583 
1584   status = 0;
1585 
1586 
1587   // Do phi dependence.
1588   phip = phi;
1589   rowoff = 0;
1590   rowlen = nphi*sxy;
1591   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
1592     sincosd(*phip, &sinphi, &cosphi);
1593 
1594     xp = x + rowoff;
1595     yp = y + rowoff;
1596     for (itheta = 0; itheta < mtheta; itheta++) {
1597       *xp = sinphi;
1598       *yp = cosphi;
1599       xp += rowlen;
1600       yp += rowlen;
1601     }
1602   }
1603 
1604 
1605   // Do theta dependence.
1606   thetap = theta;
1607   xp = x;
1608   yp = y;
1609   statp = stat;
1610   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
1611     s = 1.0 + sind(*thetap);
1612     if (s == 0.0) {
1613       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1614         *xp = 0.0;
1615         *yp = 0.0;
1616         *(statp++) = 1;
1617       }
1618       if (!status) status = PRJERR_BAD_WORLD_SET("stgs2x");
1619 
1620     } else {
1621       r = prj->w[0]*cosd(*thetap)/s;
1622 
1623       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1624         *xp =  r*(*xp) - prj->x0;
1625         *yp = -r*(*yp) - prj->y0;
1626         *(statp++) = 0;
1627       }
1628     }
1629   }
1630 
1631   return status;
1632 }
1633 
1634 /*============================================================================
1635 *   SIN: orthographic/synthesis projection.
1636 *
1637 *   Given:
1638 *      prj->pv[1:2] Obliqueness parameters, xi and eta.
1639 *
1640 *   Given and/or returned:
1641 *      prj->r0      Reset to 180/pi if 0.
1642 *      prj->phi0    Reset to  0.0 if undefined.
1643 *      prj->theta0  Reset to 90.0 if undefined.
1644 *
1645 *   Returned:
1646 *      prj->flag     SIN
1647 *      prj->code    "SIN"
1648 *      prj->x0      Fiducial offset in x.
1649 *      prj->y0      Fiducial offset in y.
1650 *      prj->w[0]    1/r0
1651 *      prj->w[1]    xi**2 + eta**2
1652 *      prj->w[2]    xi**2 + eta**2 + 1
1653 *      prj->w[3]    xi**2 + eta**2 - 1
1654 *      prj->prjx2s  Pointer to sinx2s().
1655 *      prj->prjs2x  Pointer to sins2x().
1656 *===========================================================================*/
1657 
sinset(struct prjprm * prj)1658 int sinset(struct prjprm *prj)
1659 
1660 {
1661   if (prj == 0x0) return PRJERR_NULL_POINTER;
1662 
1663   prj->flag = SIN;
1664   strcpy(prj->code, "SIN");
1665 
1666   if (undefined(prj->pv[1])) prj->pv[1] = 0.0;
1667   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
1668   if (prj->r0 == 0.0) prj->r0 = R2D;
1669 
1670   strcpy(prj->name, "orthographic/synthesis");
1671   prj->category  = ZENITHAL;
1672   prj->pvrange   = 102;
1673   prj->simplezen = (prj->pv[1] == 0.0 && prj->pv[2] == 0.0);
1674   prj->equiareal = 0;
1675   prj->conformal = 0;
1676   prj->global    = 0;
1677   prj->divergent = 0;
1678 
1679   prj->w[0] = 1.0/prj->r0;
1680   prj->w[1] = prj->pv[1]*prj->pv[1] + prj->pv[2]*prj->pv[2];
1681   prj->w[2] = prj->w[1] + 1.0;
1682   prj->w[3] = prj->w[1] - 1.0;
1683 
1684   prj->prjx2s = sinx2s;
1685   prj->prjs2x = sins2x;
1686 
1687   return prjoff(prj, 0.0, 90.0);
1688 }
1689 
1690 //----------------------------------------------------------------------------
1691 
sinx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])1692 int sinx2s(
1693   struct prjprm *prj,
1694   int nx,
1695   int ny,
1696   int sxy,
1697   int spt,
1698   const double x[],
1699   const double y[],
1700   double phi[],
1701   double theta[],
1702   int stat[])
1703 
1704 {
1705   int mx, my, rowlen, rowoff, status;
1706   const double tol = 1.0e-13;
1707   double a, b, c, d, eta, r2, sinth1, sinth2, sinthe, x0, xi, x1, xy, y0, y02,
1708          y1, z;
1709   register int ix, iy, *statp;
1710   register const double *xp, *yp;
1711   register double *phip, *thetap;
1712 
1713 
1714   // Initialize.
1715   if (prj == 0x0) return PRJERR_NULL_POINTER;
1716   if (prj->flag != SIN) {
1717     if ((status = sinset(prj))) return status;
1718   }
1719 
1720   xi  = prj->pv[1];
1721   eta = prj->pv[2];
1722 
1723   if (ny > 0) {
1724     mx = nx;
1725     my = ny;
1726   } else {
1727     mx = 1;
1728     my = 1;
1729     ny = nx;
1730   }
1731 
1732   status = 0;
1733 
1734 
1735   // Do x dependence.
1736   xp = x;
1737   rowoff = 0;
1738   rowlen = nx*spt;
1739   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
1740     x0 = (*xp + prj->x0)*prj->w[0];
1741 
1742     phip = phi + rowoff;
1743     for (iy = 0; iy < my; iy++) {
1744       *phip = x0;
1745       phip += rowlen;
1746     }
1747   }
1748 
1749 
1750   // Do y dependence.
1751   yp = y;
1752   phip   = phi;
1753   thetap = theta;
1754   statp  = stat;
1755   for (iy = 0; iy < ny; iy++, yp += sxy) {
1756     y0 = (*yp + prj->y0)*prj->w[0];
1757     y02 = y0*y0;
1758 
1759     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
1760       // Compute intermediaries.
1761       x0 = *phip;
1762       r2 = x0*x0 + y02;
1763 
1764       if (prj->w[1] == 0.0) {
1765         // Orthographic projection.
1766         if (r2 != 0.0) {
1767           *phip = atan2d(x0, -y0);
1768         } else {
1769           *phip = 0.0;
1770         }
1771 
1772         if (r2 < 0.5) {
1773           *thetap = acosd(sqrt(r2));
1774         } else if (r2 <= 1.0) {
1775           *thetap = asind(sqrt(1.0 - r2));
1776         } else {
1777           *(statp++) = 1;
1778           if (!status) status = PRJERR_BAD_PIX_SET("sinx2s")
1779           continue;
1780         }
1781 
1782       } else {
1783         // "Synthesis" projection.
1784         xy = x0*xi + y0*eta;
1785 
1786         if (r2 < 1.0e-10) {
1787           // Use small angle formula.
1788           z = r2/2.0;
1789           *thetap = 90.0 - R2D*sqrt(r2/(1.0 + xy));
1790 
1791         } else {
1792           a = prj->w[2];
1793           b = xy - prj->w[1];
1794           c = r2 - xy - xy + prj->w[3];
1795           d = b*b - a*c;
1796 
1797           // Check for a solution.
1798           if (d < 0.0) {
1799             *phip = 0.0;
1800             *thetap = 0.0;
1801             *(statp++) = 1;
1802             if (!status) status = PRJERR_BAD_PIX_SET("sinx2s")
1803             continue;
1804           }
1805           d = sqrt(d);
1806 
1807           // Choose solution closest to pole.
1808           sinth1 = (-b + d)/a;
1809           sinth2 = (-b - d)/a;
1810           sinthe = (sinth1 > sinth2) ? sinth1 : sinth2;
1811           if (sinthe > 1.0) {
1812             if (sinthe-1.0 < tol) {
1813               sinthe = 1.0;
1814             } else {
1815               sinthe = (sinth1 < sinth2) ? sinth1 : sinth2;
1816             }
1817           }
1818 
1819           if (sinthe < -1.0) {
1820             if (sinthe+1.0 > -tol) {
1821               sinthe = -1.0;
1822             }
1823           }
1824 
1825           if (sinthe > 1.0 || sinthe < -1.0) {
1826             *phip = 0.0;
1827             *thetap = 0.0;
1828             *(statp++) = 1;
1829             if (!status) status = PRJERR_BAD_PIX_SET("sinx2s")
1830             continue;
1831           }
1832 
1833           *thetap = asind(sinthe);
1834           z = 1.0 - sinthe;
1835         }
1836 
1837         x1 = -y0 + eta*z;
1838         y1 =  x0 -  xi*z;
1839         if (x1 == 0.0 && y1 == 0.0) {
1840           *phip = 0.0;
1841         } else {
1842           *phip = atan2d(y1,x1);
1843         }
1844       }
1845 
1846       *(statp++) = 0;
1847     }
1848   }
1849 
1850 
1851   // Do bounds checking on the native coordinates.
1852   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
1853     if (!status) status = PRJERR_BAD_PIX_SET("sinx2s");
1854   }
1855 
1856   return status;
1857 }
1858 
1859 //----------------------------------------------------------------------------
1860 
sins2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])1861 int sins2x(
1862   struct prjprm *prj,
1863   int nphi,
1864   int ntheta,
1865   int spt,
1866   int sxy,
1867   const double phi[],
1868   const double theta[],
1869   double x[],
1870   double y[],
1871   int stat[])
1872 
1873 {
1874   int mphi, mtheta, rowlen, rowoff, status;
1875   double cosphi, costhe, sinphi, r, t, z, z1, z2;
1876   register int iphi, itheta, istat, *statp;
1877   register const double *phip, *thetap;
1878   register double *xp, *yp;
1879 
1880 
1881   // Initialize.
1882   if (prj == 0x0) return PRJERR_NULL_POINTER;
1883   if (prj->flag != SIN) {
1884     if ((status = sinset(prj))) return status;
1885   }
1886 
1887   if (ntheta > 0) {
1888     mphi   = nphi;
1889     mtheta = ntheta;
1890   } else {
1891     mphi   = 1;
1892     mtheta = 1;
1893     ntheta = nphi;
1894   }
1895 
1896   status = 0;
1897 
1898 
1899   // Do phi dependence.
1900   phip = phi;
1901   rowoff = 0;
1902   rowlen = nphi*sxy;
1903   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
1904     sincosd(*phip, &sinphi, &cosphi);
1905 
1906     xp = x + rowoff;
1907     yp = y + rowoff;
1908     for (itheta = 0; itheta < mtheta; itheta++) {
1909       *xp = sinphi;
1910       *yp = cosphi;
1911       xp += rowlen;
1912       yp += rowlen;
1913     }
1914   }
1915 
1916 
1917   // Do theta dependence.
1918   thetap = theta;
1919   xp = x;
1920   yp = y;
1921   statp = stat;
1922   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
1923     t = (90.0 - fabs(*thetap))*D2R;
1924     if (t < 1.0e-5) {
1925       if (*thetap > 0.0) {
1926          z = t*t/2.0;
1927       } else {
1928          z = 2.0 - t*t/2.0;
1929       }
1930       costhe = t;
1931     } else {
1932       z = 1.0 - sind(*thetap);
1933       costhe = cosd(*thetap);
1934     }
1935     r = prj->r0*costhe;
1936 
1937     if (prj->w[1] == 0.0) {
1938       // Orthographic projection.
1939       istat = 0;
1940       if (prj->bounds&1) {
1941         if (*thetap < 0.0) {
1942           istat = 1;
1943           if (!status) status = PRJERR_BAD_WORLD_SET("sins2x");
1944         }
1945       }
1946 
1947       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1948         *xp =  r*(*xp) - prj->x0;
1949         *yp = -r*(*yp) - prj->y0;
1950         *(statp++) = istat;
1951       }
1952 
1953     } else {
1954       // "Synthesis" projection.
1955       z *= prj->r0;
1956       z1 = prj->pv[1]*z - prj->x0;
1957       z2 = prj->pv[2]*z - prj->y0;
1958 
1959       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
1960         istat = 0;
1961         if (prj->bounds&1) {
1962           t = -atand(prj->pv[1]*(*xp) - prj->pv[2]*(*yp));
1963           if (*thetap < t) {
1964             istat = 1;
1965             if (!status) status = PRJERR_BAD_WORLD_SET("sins2x");
1966           }
1967         }
1968 
1969         *xp =  r*(*xp) + z1;
1970         *yp = -r*(*yp) + z2;
1971         *(statp++) = istat;
1972       }
1973     }
1974   }
1975 
1976   return status;
1977 }
1978 
1979 /*============================================================================
1980 *   ARC: zenithal/azimuthal equidistant projection.
1981 *
1982 *   Given and/or returned:
1983 *      prj->r0      Reset to 180/pi if 0.
1984 *      prj->phi0    Reset to  0.0 if undefined.
1985 *      prj->theta0  Reset to 90.0 if undefined.
1986 *
1987 *   Returned:
1988 *      prj->flag     ARC
1989 *      prj->code    "ARC"
1990 *      prj->x0      Fiducial offset in x.
1991 *      prj->y0      Fiducial offset in y.
1992 *      prj->w[0]    r0*(pi/180)
1993 *      prj->w[1]    (180/pi)/r0
1994 *      prj->prjx2s  Pointer to arcx2s().
1995 *      prj->prjs2x  Pointer to arcs2x().
1996 *===========================================================================*/
1997 
arcset(struct prjprm * prj)1998 int arcset(struct prjprm *prj)
1999 
2000 {
2001   if (prj == 0x0) return PRJERR_NULL_POINTER;
2002 
2003   prj->flag = ARC;
2004   strcpy(prj->code, "ARC");
2005 
2006   strcpy(prj->name, "zenithal/azimuthal equidistant");
2007   prj->category  = ZENITHAL;
2008   prj->pvrange   = 0;
2009   prj->simplezen = 1;
2010   prj->equiareal = 0;
2011   prj->conformal = 0;
2012   prj->global    = 1;
2013   prj->divergent = 0;
2014 
2015   if (prj->r0 == 0.0) {
2016     prj->r0 = R2D;
2017     prj->w[0] = 1.0;
2018     prj->w[1] = 1.0;
2019   } else {
2020     prj->w[0] = prj->r0*D2R;
2021     prj->w[1] = 1.0/prj->w[0];
2022   }
2023 
2024   prj->prjx2s = arcx2s;
2025   prj->prjs2x = arcs2x;
2026 
2027   return prjoff(prj, 0.0, 90.0);
2028 }
2029 
2030 //----------------------------------------------------------------------------
2031 
arcx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])2032 int arcx2s(
2033   struct prjprm *prj,
2034   int nx,
2035   int ny,
2036   int sxy,
2037   int spt,
2038   const double x[],
2039   const double y[],
2040   double phi[],
2041   double theta[],
2042   int stat[])
2043 
2044 {
2045   int mx, my, rowlen, rowoff, status;
2046   double r, xj, yj, yj2;
2047   register int ix, iy, *statp;
2048   register const double *xp, *yp;
2049   register double *phip, *thetap;
2050 
2051 
2052   // Initialize.
2053   if (prj == 0x0) return PRJERR_NULL_POINTER;
2054   if (prj->flag != ARC) {
2055     if ((status = arcset(prj))) return status;
2056   }
2057 
2058   if (ny > 0) {
2059     mx = nx;
2060     my = ny;
2061   } else {
2062     mx = 1;
2063     my = 1;
2064     ny = nx;
2065   }
2066 
2067   status = 0;
2068 
2069 
2070   // Do x dependence.
2071   xp = x;
2072   rowoff = 0;
2073   rowlen = nx*spt;
2074   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
2075     xj = *xp + prj->x0;
2076 
2077     phip = phi + rowoff;
2078     for (iy = 0; iy < my; iy++) {
2079       *phip = xj;
2080       phip += rowlen;
2081     }
2082   }
2083 
2084 
2085   // Do y dependence.
2086   yp = y;
2087   phip   = phi;
2088   thetap = theta;
2089   statp  = stat;
2090   for (iy = 0; iy < ny; iy++, yp += sxy) {
2091     yj  = *yp + prj->y0;
2092     yj2 = yj*yj;
2093 
2094     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
2095       xj = *phip;
2096 
2097       r = sqrt(xj*xj + yj2);
2098       if (r == 0.0) {
2099         *phip = 0.0;
2100         *thetap = 90.0;
2101       } else {
2102         *phip = atan2d(xj, -yj);
2103         *thetap = 90.0 - r*prj->w[1];
2104       }
2105 
2106       *(statp++) = 0;
2107     }
2108   }
2109 
2110 
2111   // Do bounds checking on the native coordinates.
2112   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
2113     if (!status) status = PRJERR_BAD_PIX_SET("arcx2s");
2114   }
2115 
2116   return status;
2117 }
2118 
2119 //----------------------------------------------------------------------------
2120 
arcs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])2121 int arcs2x(
2122   struct prjprm *prj,
2123   int nphi,
2124   int ntheta,
2125   int spt,
2126   int sxy,
2127   const double phi[],
2128   const double theta[],
2129   double x[],
2130   double y[],
2131   int stat[])
2132 
2133 {
2134   int mphi, mtheta, rowlen, rowoff, status;
2135   double cosphi, r, sinphi;
2136   register int iphi, itheta, *statp;
2137   register const double *phip, *thetap;
2138   register double *xp, *yp;
2139 
2140 
2141   // Initialize.
2142   if (prj == 0x0) return PRJERR_NULL_POINTER;
2143   if (prj->flag != ARC) {
2144     if ((status = arcset(prj))) return status;
2145   }
2146 
2147   if (ntheta > 0) {
2148     mphi   = nphi;
2149     mtheta = ntheta;
2150   } else {
2151     mphi   = 1;
2152     mtheta = 1;
2153     ntheta = nphi;
2154   }
2155 
2156 
2157   // Do phi dependence.
2158   phip = phi;
2159   rowoff = 0;
2160   rowlen = nphi*sxy;
2161   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
2162     sincosd(*phip, &sinphi, &cosphi);
2163 
2164     xp = x + rowoff;
2165     yp = y + rowoff;
2166     for (itheta = 0; itheta < mtheta; itheta++) {
2167       *xp = sinphi;
2168       *yp = cosphi;
2169       xp += rowlen;
2170       yp += rowlen;
2171     }
2172   }
2173 
2174 
2175   // Do theta dependence.
2176   thetap = theta;
2177   xp = x;
2178   yp = y;
2179   statp = stat;
2180   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
2181     r =  prj->w[0]*(90.0 - *thetap);
2182 
2183     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
2184       *xp =  r*(*xp) - prj->x0;
2185       *yp = -r*(*yp) - prj->y0;
2186       *(statp++) = 0;
2187     }
2188   }
2189 
2190   return 0;
2191 }
2192 
2193 /*============================================================================
2194 *   ZPN: zenithal/azimuthal polynomial projection.
2195 *
2196 *   Given:
2197 *      prj->pv[]    Polynomial coefficients.
2198 *
2199 *   Given and/or returned:
2200 *      prj->r0      Reset to 180/pi if 0.
2201 *      prj->phi0    Reset to  0.0 if undefined.
2202 *      prj->theta0  Reset to 90.0 if undefined.
2203 *
2204 *   Returned:
2205 *      prj->flag     ZPN
2206 *      prj->code    "ZPN"
2207 *      prj->x0      Fiducial offset in x.
2208 *      prj->y0      Fiducial offset in y.
2209 *      prj->n       Degree of the polynomial, N.
2210 *      prj->w[0]    Co-latitude of the first point of inflection, radian.
2211 *      prj->w[1]    Radius of the first point of inflection (N > 1), radian.
2212 *      prj->prjx2s  Pointer to zpnx2s().
2213 *      prj->prjs2x  Pointer to zpns2x().
2214 *===========================================================================*/
2215 
zpnset(struct prjprm * prj)2216 int zpnset(struct prjprm *prj)
2217 
2218 {
2219   int j, k, m;
2220   double d, d1, d2, r, zd, zd1, zd2;
2221   const double tol = 1.0e-13;
2222 
2223   if (prj == 0x0) return PRJERR_NULL_POINTER;
2224 
2225   strcpy(prj->code, "ZPN");
2226   prj->flag = ZPN;
2227 
2228   if (undefined(prj->pv[1])) prj->pv[1] = 0.0;
2229   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
2230   if (undefined(prj->pv[3])) prj->pv[3] = 0.0;
2231   if (prj->r0 == 0.0) prj->r0 = R2D;
2232 
2233   strcpy(prj->name, "zenithal/azimuthal polynomial");
2234   prj->category  = ZENITHAL;
2235   prj->pvrange   = 30;
2236   prj->simplezen = 1;
2237   prj->equiareal = 0;
2238   prj->conformal = 0;
2239   prj->global    = 0;
2240   prj->divergent = 0;
2241 
2242   // Find the highest non-zero coefficient.
2243   for (k = PVN-1; k >= 0 && prj->pv[k] == 0.0; k--);
2244   if (k < 0) {
2245     return PRJERR_BAD_PARAM_SET("zpnset");
2246   }
2247 
2248   prj->n = k;
2249 
2250   if (k < 2) {
2251     // No point of inflection.
2252     prj->w[0] = PI;
2253 
2254   } else {
2255     // Find the point of inflection closest to the pole.
2256     zd1 = 0.0;
2257     d1  = prj->pv[1];
2258     if (d1 <= 0.0) {
2259       return PRJERR_BAD_PARAM_SET("zpnset");
2260     }
2261 
2262     // Find the point where the derivative first goes negative.
2263     for (j = 0; j < 180; j++) {
2264       zd2 = j*D2R;
2265       d2  = 0.0;
2266       for (m = k; m > 0; m--) {
2267         d2 = d2*zd2 + m*prj->pv[m];
2268       }
2269 
2270       if (d2 <= 0.0) break;
2271       zd1 = zd2;
2272       d1  = d2;
2273     }
2274 
2275     if (j == 180) {
2276       // No negative derivative -> no point of inflection.
2277       zd = PI;
2278       prj->global = 1;
2279     } else {
2280       // Find where the derivative is zero.
2281       for (j = 1; j <= 10; j++) {
2282         zd = zd1 - d1*(zd2-zd1)/(d2-d1);
2283 
2284         d = 0.0;
2285         for (m = k; m > 0; m--) {
2286           d = d*zd + m*prj->pv[m];
2287         }
2288 
2289         if (fabs(d) < tol) break;
2290 
2291         if (d < 0.0) {
2292           zd2 = zd;
2293           d2  = d;
2294         } else {
2295           zd1 = zd;
2296           d1  = d;
2297         }
2298       }
2299     }
2300 
2301     r = 0.0;
2302     for (m = k; m >= 0; m--) {
2303       r = r*zd + prj->pv[m];
2304     }
2305     prj->w[0] = zd;
2306     prj->w[1] = r;
2307   }
2308 
2309   prj->prjx2s = zpnx2s;
2310   prj->prjs2x = zpns2x;
2311 
2312   return prjoff(prj, 0.0, 90.0);
2313 }
2314 
2315 //----------------------------------------------------------------------------
2316 
zpnx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])2317 int zpnx2s(
2318   struct prjprm *prj,
2319   int nx,
2320   int ny,
2321   int sxy,
2322   int spt,
2323   const double x[],
2324   const double y[],
2325   double phi[],
2326   double theta[],
2327   int stat[])
2328 
2329 {
2330   int j, k, m, mx, my, rowlen, rowoff, status;
2331   double a, b, c, d, lambda, r, r1, r2, rt, xj, yj, yj2, zd, zd1, zd2;
2332   const double tol = 1.0e-13;
2333   register int ix, iy, *statp;
2334   register const double *xp, *yp;
2335   register double *phip, *thetap;
2336 
2337 
2338   // Initialize.
2339   if (prj == 0x0) return PRJERR_NULL_POINTER;
2340   if (prj->flag != ZPN) {
2341     if ((status = zpnset(prj))) return status;
2342   }
2343 
2344   k = prj->n;
2345 
2346   if (ny > 0) {
2347     mx = nx;
2348     my = ny;
2349   } else {
2350     mx = 1;
2351     my = 1;
2352     ny = nx;
2353   }
2354 
2355   status = 0;
2356 
2357 
2358   // Do x dependence.
2359   xp = x;
2360   rowoff = 0;
2361   rowlen = nx*spt;
2362   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
2363     xj = *xp + prj->x0;
2364 
2365     phip = phi + rowoff;
2366     for (iy = 0; iy < my; iy++) {
2367       *phip = xj;
2368       phip += rowlen;
2369     }
2370   }
2371 
2372 
2373   // Do y dependence.
2374   yp = y;
2375   phip   = phi;
2376   thetap = theta;
2377   statp  = stat;
2378   for (iy = 0; iy < ny; iy++, yp += sxy) {
2379     yj  = *yp + prj->y0;
2380     yj2 = yj*yj;
2381 
2382     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
2383       xj = *phip;
2384 
2385       r = sqrt(xj*xj + yj2)/prj->r0;
2386       if (r == 0.0) {
2387         *phip = 0.0;
2388       } else {
2389         *phip = atan2d(xj, -yj);
2390       }
2391 
2392       if (k < 1) {
2393         // Constant - no solution.
2394         return PRJERR_BAD_PARAM_SET("zpnx2s");
2395 
2396       } else if (k == 1) {
2397         // Linear.
2398         zd = (r - prj->pv[0])/prj->pv[1];
2399 
2400       } else if (k == 2) {
2401         // Quadratic.
2402         a = prj->pv[2];
2403         b = prj->pv[1];
2404         c = prj->pv[0] - r;
2405 
2406         d = b*b - 4.0*a*c;
2407         if (d < 0.0) {
2408           *thetap = 0.0;
2409           *(statp++) = 1;
2410           if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2411           continue;
2412         }
2413         d = sqrt(d);
2414 
2415         // Choose solution closest to pole.
2416         zd1 = (-b + d)/(2.0*a);
2417         zd2 = (-b - d)/(2.0*a);
2418         zd  = (zd1<zd2) ? zd1 : zd2;
2419         if (zd < -tol) zd = (zd1>zd2) ? zd1 : zd2;
2420         if (zd < 0.0) {
2421           if (zd < -tol) {
2422             *thetap = 0.0;
2423             *(statp++) = 1;
2424             if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2425             continue;
2426           }
2427           zd = 0.0;
2428         } else if (zd > PI) {
2429           if (zd > PI+tol) {
2430             *thetap = 0.0;
2431             *(statp++) = 1;
2432             if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2433             continue;
2434           }
2435           zd = PI;
2436         }
2437       } else {
2438         // Higher order - solve iteratively.
2439         zd1 = 0.0;
2440         r1  = prj->pv[0];
2441         zd2 = prj->w[0];
2442         r2  = prj->w[1];
2443 
2444         if (r < r1) {
2445           if (r < r1-tol) {
2446             *thetap = 0.0;
2447             *(statp++) = 1;
2448             if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2449             continue;
2450           }
2451           zd = zd1;
2452         } else if (r > r2) {
2453           if (r > r2+tol) {
2454             *thetap = 0.0;
2455             *(statp++) = 1;
2456             if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2457             continue;
2458           }
2459           zd = zd2;
2460         } else {
2461           // Dissect the interval.
2462           for (j = 0; j < 100; j++) {
2463             lambda = (r2 - r)/(r2 - r1);
2464             if (lambda < 0.1) {
2465               lambda = 0.1;
2466             } else if (lambda > 0.9) {
2467               lambda = 0.9;
2468             }
2469 
2470             zd = zd2 - lambda*(zd2 - zd1);
2471 
2472             rt = 0.0;
2473             for (m = k; m >= 0; m--) {
2474               rt = (rt * zd) + prj->pv[m];
2475             }
2476 
2477             if (rt < r) {
2478               if (r-rt < tol) break;
2479               r1 = rt;
2480               zd1 = zd;
2481             } else {
2482               if (rt-r < tol) break;
2483               r2 = rt;
2484               zd2 = zd;
2485             }
2486 
2487             if (fabs(zd2-zd1) < tol) break;
2488           }
2489         }
2490       }
2491 
2492       *thetap = 90.0 - zd*R2D;
2493       *(statp++) = 0;
2494     }
2495   }
2496 
2497 
2498   // Do bounds checking on the native coordinates.
2499   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
2500     if (!status) status = PRJERR_BAD_PIX_SET("zpnx2s");
2501   }
2502 
2503   return status;
2504 }
2505 
2506 //----------------------------------------------------------------------------
2507 
zpns2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])2508 int zpns2x(
2509   struct prjprm *prj,
2510   int nphi,
2511   int ntheta,
2512   int spt,
2513   int sxy,
2514   const double phi[],
2515   const double theta[],
2516   double x[],
2517   double y[],
2518   int stat[])
2519 
2520 {
2521   int m, mphi, mtheta, rowlen, rowoff, status;
2522   double cosphi, r, s, sinphi;
2523   register int iphi, itheta, istat, *statp;
2524   register const double *phip, *thetap;
2525   register double *xp, *yp;
2526 
2527 
2528   // Initialize.
2529   if (prj == 0x0) return PRJERR_NULL_POINTER;
2530   if (prj->flag != ZPN) {
2531     if ((status = zpnset(prj))) return status;
2532   }
2533 
2534   if (ntheta > 0) {
2535     mphi   = nphi;
2536     mtheta = ntheta;
2537   } else {
2538     mphi   = 1;
2539     mtheta = 1;
2540     ntheta = nphi;
2541   }
2542 
2543   status = 0;
2544 
2545 
2546   // Do phi dependence.
2547   phip = phi;
2548   rowoff = 0;
2549   rowlen = nphi*sxy;
2550   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
2551     sincosd(*phip, &sinphi, &cosphi);
2552 
2553     xp = x + rowoff;
2554     yp = y + rowoff;
2555     for (itheta = 0; itheta < mtheta; itheta++) {
2556       *xp = sinphi;
2557       *yp = cosphi;
2558       xp += rowlen;
2559       yp += rowlen;
2560     }
2561   }
2562 
2563 
2564   // Do theta dependence.
2565   thetap = theta;
2566   xp = x;
2567   yp = y;
2568   statp = stat;
2569   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
2570     s = (90.0 - *thetap)*D2R;
2571 
2572     r = 0.0;
2573     for (m = prj->n; m >= 0; m--) {
2574       r = r*s + prj->pv[m];
2575     }
2576     r *= prj->r0;
2577 
2578     // Bounds checking.
2579     istat = 0;
2580     if (prj->bounds&1) {
2581       if (s > prj->w[0]) {
2582         istat = 1;
2583         if (!status) status = PRJERR_BAD_WORLD_SET("zpns2x");
2584       }
2585     }
2586 
2587     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
2588       *xp =  r*(*xp) - prj->x0;
2589       *yp = -r*(*yp) - prj->y0;
2590       *(statp++) = istat;
2591     }
2592   }
2593 
2594   return status;
2595 }
2596 
2597 /*============================================================================
2598 *   ZEA: zenithal/azimuthal equal area projection.
2599 *
2600 *   Given and/or returned:
2601 *      prj->r0      Reset to 180/pi if 0.
2602 *      prj->phi0    Reset to  0.0 if undefined.
2603 *      prj->theta0  Reset to 90.0 if undefined.
2604 *
2605 *   Returned:
2606 *      prj->flag     ZEA
2607 *      prj->code    "ZEA"
2608 *      prj->x0      Fiducial offset in x.
2609 *      prj->y0      Fiducial offset in y.
2610 *      prj->w[0]    2*r0
2611 *      prj->w[1]    1/(2*r0)
2612 *      prj->prjx2s  Pointer to zeax2s().
2613 *      prj->prjs2x  Pointer to zeas2x().
2614 *===========================================================================*/
2615 
zeaset(struct prjprm * prj)2616 int zeaset(struct prjprm *prj)
2617 
2618 {
2619   if (prj == 0x0) return PRJERR_NULL_POINTER;
2620 
2621   prj->flag = ZEA;
2622   strcpy(prj->code, "ZEA");
2623 
2624   strcpy(prj->name, "zenithal/azimuthal equal area");
2625   prj->category  = ZENITHAL;
2626   prj->pvrange   = 0;
2627   prj->simplezen = 1;
2628   prj->equiareal = 1;
2629   prj->conformal = 0;
2630   prj->global    = 1;
2631   prj->divergent = 0;
2632 
2633   if (prj->r0 == 0.0) {
2634     prj->r0 = R2D;
2635     prj->w[0] = 360.0/PI;
2636     prj->w[1] = PI/360.0;
2637   } else {
2638     prj->w[0] = 2.0*prj->r0;
2639     prj->w[1] = 1.0/prj->w[0];
2640   }
2641 
2642   prj->prjx2s = zeax2s;
2643   prj->prjs2x = zeas2x;
2644 
2645   return prjoff(prj, 0.0, 90.0);
2646 }
2647 
2648 //----------------------------------------------------------------------------
2649 
zeax2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])2650 int zeax2s(
2651   struct prjprm *prj,
2652   int nx,
2653   int ny,
2654   int sxy,
2655   int spt,
2656   const double x[],
2657   const double y[],
2658   double phi[],
2659   double theta[],
2660   int stat[])
2661 
2662 {
2663   int mx, my, rowlen, rowoff, status;
2664   double r, s, xj, yj, yj2;
2665   const double tol = 1.0e-12;
2666   register int ix, iy, *statp;
2667   register const double *xp, *yp;
2668   register double *phip, *thetap;
2669 
2670 
2671   // Initialize.
2672   if (prj == 0x0) return PRJERR_NULL_POINTER;
2673   if (prj->flag != ZEA) {
2674     if ((status = zeaset(prj))) return status;
2675   }
2676 
2677   if (ny > 0) {
2678     mx = nx;
2679     my = ny;
2680   } else {
2681     mx = 1;
2682     my = 1;
2683     ny = nx;
2684   }
2685 
2686   status = 0;
2687 
2688 
2689   // Do x dependence.
2690   xp = x;
2691   rowoff = 0;
2692   rowlen = nx*spt;
2693   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
2694     xj = *xp + prj->x0;
2695 
2696     phip = phi + rowoff;
2697     for (iy = 0; iy < my; iy++) {
2698       *phip = xj;
2699       phip += rowlen;
2700     }
2701   }
2702 
2703 
2704   // Do y dependence.
2705   yp = y;
2706   phip   = phi;
2707   thetap = theta;
2708   statp  = stat;
2709   for (iy = 0; iy < ny; iy++, yp += sxy) {
2710     yj  = *yp + prj->y0;
2711     yj2 = yj*yj;
2712 
2713     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
2714       xj  = *phip;
2715 
2716       r = sqrt(xj*xj + yj2);
2717       if (r == 0.0) {
2718         *phip = 0.0;
2719       } else {
2720         *phip = atan2d(xj, -yj);
2721       }
2722 
2723       s = r*prj->w[1];
2724       if (fabs(s) > 1.0) {
2725         if (fabs(r - prj->w[0]) < tol) {
2726           *thetap = -90.0;
2727         } else {
2728           *thetap = 0.0;
2729           *(statp++) = 1;
2730           if (!status) status = PRJERR_BAD_PIX_SET("zeax2s");
2731           continue;
2732         }
2733       } else {
2734         *thetap = 90.0 - 2.0*asind(s);
2735       }
2736 
2737       *(statp++) = 0;
2738     }
2739   }
2740 
2741 
2742   // Do bounds checking on the native coordinates.
2743   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
2744     if (!status) status = PRJERR_BAD_PIX_SET("zeax2s");
2745   }
2746 
2747   return status;
2748 }
2749 
2750 //----------------------------------------------------------------------------
2751 
zeas2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])2752 int zeas2x(
2753   struct prjprm *prj,
2754   int nphi,
2755   int ntheta,
2756   int spt,
2757   int sxy,
2758   const double phi[],
2759   const double theta[],
2760   double x[],
2761   double y[],
2762   int stat[])
2763 
2764 {
2765   int mphi, mtheta, rowlen, rowoff, status;
2766   double cosphi, r, sinphi;
2767   register int iphi, itheta, *statp;
2768   register const double *phip, *thetap;
2769   register double *xp, *yp;
2770 
2771 
2772   // Initialize.
2773   if (prj == 0x0) return PRJERR_NULL_POINTER;
2774   if (prj->flag != ZEA) {
2775     if ((status = zeaset(prj))) return status;
2776   }
2777 
2778   if (ntheta > 0) {
2779     mphi   = nphi;
2780     mtheta = ntheta;
2781   } else {
2782     mphi   = 1;
2783     mtheta = 1;
2784     ntheta = nphi;
2785   }
2786 
2787 
2788   // Do phi dependence.
2789   phip = phi;
2790   rowoff = 0;
2791   rowlen = nphi*sxy;
2792   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
2793     sincosd(*phip, &sinphi, &cosphi);
2794 
2795     xp = x + rowoff;
2796     yp = y + rowoff;
2797     for (itheta = 0; itheta < mtheta; itheta++) {
2798       *xp = sinphi;
2799       *yp = cosphi;
2800       xp += rowlen;
2801       yp += rowlen;
2802     }
2803   }
2804 
2805 
2806   // Do theta dependence.
2807   thetap = theta;
2808   xp = x;
2809   yp = y;
2810   statp = stat;
2811   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
2812     r =  prj->w[0]*sind((90.0 - *thetap)/2.0);
2813 
2814     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
2815       *xp =  r*(*xp) - prj->x0;
2816       *yp = -r*(*yp) - prj->y0;
2817       *(statp++) = 0;
2818     }
2819   }
2820 
2821   return 0;
2822 }
2823 
2824 /*============================================================================
2825 *   AIR: Airy's projection.
2826 *
2827 *   Given:
2828 *      prj->pv[1]   Latitude theta_b within which the error is minimized, in
2829 *                   degrees.
2830 *
2831 *   Given and/or returned:
2832 *      prj->r0      Reset to 180/pi if 0.
2833 *      prj->phi0    Reset to  0.0 if undefined.
2834 *      prj->theta0  Reset to 90.0 if undefined.
2835 *
2836 *   Returned:
2837 *      prj->flag     AIR
2838 *      prj->code    "AIR"
2839 *      prj->x0      Fiducial offset in x.
2840 *      prj->y0      Fiducial offset in y.
2841 *      prj->w[0]    2*r0
2842 *      prj->w[1]    ln(cos(xi_b))/tan(xi_b)**2, where xi_b = (90-theta_b)/2
2843 *      prj->w[2]    1/2 - prj->w[1]
2844 *      prj->w[3]    2*r0*prj->w[2]
2845 *      prj->w[4]    tol, cutoff for using small angle approximation, in
2846 *                   radians.
2847 *      prj->w[5]    prj->w[2]*tol
2848 *      prj->w[6]    (180/pi)/prj->w[2]
2849 *      prj->prjx2s  Pointer to airx2s().
2850 *      prj->prjs2x  Pointer to airs2x().
2851 *===========================================================================*/
2852 
airset(struct prjprm * prj)2853 int airset(struct prjprm *prj)
2854 
2855 {
2856   const double tol = 1.0e-4;
2857   double cosxi;
2858 
2859   if (prj == 0x0) return PRJERR_NULL_POINTER;
2860 
2861   prj->flag = AIR;
2862   strcpy(prj->code, "AIR");
2863 
2864   if (undefined(prj->pv[1])) prj->pv[1] = 90.0;
2865   if (prj->r0 == 0.0) prj->r0 = R2D;
2866 
2867   strcpy(prj->name, "Airy's zenithal");
2868   prj->category  = ZENITHAL;
2869   prj->pvrange   = 101;
2870   prj->simplezen = 1;
2871   prj->equiareal = 0;
2872   prj->conformal = 0;
2873   prj->global    = 0;
2874   prj->divergent = 1;
2875 
2876   prj->w[0] = 2.0*prj->r0;
2877   if (prj->pv[1] == 90.0) {
2878     prj->w[1] = -0.5;
2879     prj->w[2] =  1.0;
2880   } else if (prj->pv[1] > -90.0) {
2881     cosxi = cosd((90.0 - prj->pv[1])/2.0);
2882     prj->w[1] = log(cosxi)*(cosxi*cosxi)/(1.0-cosxi*cosxi);
2883     prj->w[2] = 0.5 - prj->w[1];
2884   } else {
2885     return PRJERR_BAD_PARAM_SET("airset");
2886   }
2887 
2888   prj->w[3] = prj->w[0] * prj->w[2];
2889   prj->w[4] = tol;
2890   prj->w[5] = prj->w[2]*tol;
2891   prj->w[6] = R2D/prj->w[2];
2892 
2893   prj->prjx2s = airx2s;
2894   prj->prjs2x = airs2x;
2895 
2896   return prjoff(prj, 0.0, 90.0);
2897 }
2898 
2899 //----------------------------------------------------------------------------
2900 
airx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])2901 int airx2s(
2902   struct prjprm *prj,
2903   int nx,
2904   int ny,
2905   int sxy,
2906   int spt,
2907   const double x[],
2908   const double y[],
2909   double phi[],
2910   double theta[],
2911   int stat[])
2912 
2913 {
2914   int k, mx, my, rowlen, rowoff, status;
2915   double cosxi, lambda, r, r1, r2, rt, tanxi, x1, x2, xi, xj, yj, yj2;
2916   const double tol = 1.0e-12;
2917   register int ix, iy, *statp;
2918   register const double *xp, *yp;
2919   register double *phip, *thetap;
2920 
2921 
2922   // Initialize.
2923   if (prj == 0x0) return PRJERR_NULL_POINTER;
2924   if (prj->flag != AIR) {
2925     if ((status = airset(prj))) return status;
2926   }
2927 
2928   if (ny > 0) {
2929     mx = nx;
2930     my = ny;
2931   } else {
2932     mx = 1;
2933     my = 1;
2934     ny = nx;
2935   }
2936 
2937   status = 0;
2938 
2939 
2940   // Do x dependence.
2941   xp = x;
2942   rowoff = 0;
2943   rowlen = nx*spt;
2944   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
2945     xj = *xp + prj->x0;
2946 
2947     phip = phi + rowoff;
2948     for (iy = 0; iy < my; iy++) {
2949       *phip = xj;
2950       phip += rowlen;
2951     }
2952   }
2953 
2954 
2955   // Do y dependence.
2956   yp = y;
2957   phip   = phi;
2958   thetap = theta;
2959   statp  = stat;
2960   for (iy = 0; iy < ny; iy++, yp += sxy) {
2961     yj  = *yp + prj->y0;
2962     yj2 = yj*yj;
2963 
2964     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
2965       xj = *phip;
2966 
2967       r = sqrt(xj*xj + yj2)/prj->w[0];
2968       if (r == 0.0) {
2969         *phip = 0.0;
2970       } else {
2971         *phip = atan2d(xj, -yj);
2972       }
2973 
2974 
2975       if (r == 0.0) {
2976         xi = 0.0;
2977       } else if (r < prj->w[5]) {
2978         xi = r*prj->w[6];
2979       } else {
2980         // Find a solution interval.
2981         x1 = x2 = 1.0;
2982         r1 = r2 = 0.0;
2983         for (k = 0; k < 30; k++) {
2984           x2 = x1/2.0;
2985           tanxi = sqrt(1.0-x2*x2)/x2;
2986           r2 = -(log(x2)/tanxi + prj->w[1]*tanxi);
2987 
2988           if (r2 >= r) break;
2989           x1 = x2;
2990           r1 = r2;
2991         }
2992         if (k == 30) {
2993           *thetap = 0.0;
2994           *(statp++) = 1;
2995           if (!status) status = PRJERR_BAD_PIX_SET("airx2s");
2996           continue;
2997         }
2998 
2999         for (k = 0; k < 100; k++) {
3000           // Weighted division of the interval.
3001           lambda = (r2-r)/(r2-r1);
3002           if (lambda < 0.1) {
3003             lambda = 0.1;
3004           } else if (lambda > 0.9) {
3005             lambda = 0.9;
3006           }
3007           cosxi = x2 - lambda*(x2-x1);
3008 
3009           tanxi = sqrt(1.0-cosxi*cosxi)/cosxi;
3010           rt = -(log(cosxi)/tanxi + prj->w[1]*tanxi);
3011 
3012           if (rt < r) {
3013             if (r-rt < tol) break;
3014             r1 = rt;
3015             x1 = cosxi;
3016           } else {
3017             if (rt-r < tol) break;
3018             r2 = rt;
3019             x2 = cosxi;
3020           }
3021         }
3022         if (k == 100) {
3023           *thetap = 0.0;
3024           *(statp++) = 1;
3025           if (!status) status = PRJERR_BAD_PIX_SET("airx2s");
3026           continue;
3027         }
3028 
3029         xi = acosd(cosxi);
3030       }
3031 
3032       *thetap = 90.0 - 2.0*xi;
3033       *(statp++) = 0;
3034     }
3035   }
3036 
3037 
3038   // Do bounds checking on the native coordinates.
3039   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
3040     if (!status) status = PRJERR_BAD_PIX_SET("airx2s");
3041   }
3042 
3043   return status;
3044 }
3045 
3046 //----------------------------------------------------------------------------
3047 
airs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])3048 int airs2x(
3049   struct prjprm *prj,
3050   int nphi,
3051   int ntheta,
3052   int spt,
3053   int sxy,
3054   const double phi[],
3055   const double theta[],
3056   double x[],
3057   double y[],
3058   int stat[])
3059 
3060 {
3061   int mphi, mtheta, rowlen, rowoff, status;
3062   double cosphi, cosxi, r, tanxi, xi, sinphi;
3063   register int iphi, itheta, istat, *statp;
3064   register const double *phip, *thetap;
3065   register double *xp, *yp;
3066 
3067 
3068   // Initialize.
3069   if (prj == 0x0) return PRJERR_NULL_POINTER;
3070   if (prj->flag != AIR) {
3071     if ((status = airset(prj))) return status;
3072   }
3073 
3074   if (ntheta > 0) {
3075     mphi   = nphi;
3076     mtheta = ntheta;
3077   } else {
3078     mphi   = 1;
3079     mtheta = 1;
3080     ntheta = nphi;
3081   }
3082 
3083   status = 0;
3084 
3085 
3086   // Do phi dependence.
3087   phip = phi;
3088   rowoff = 0;
3089   rowlen = nphi*sxy;
3090   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
3091     sincosd(*phip, &sinphi, &cosphi);
3092 
3093     xp = x + rowoff;
3094     yp = y + rowoff;
3095     for (itheta = 0; itheta < mtheta; itheta++) {
3096       *xp = sinphi;
3097       *yp = cosphi;
3098       xp += rowlen;
3099       yp += rowlen;
3100     }
3101   }
3102 
3103 
3104   // Do theta dependence.
3105   thetap = theta;
3106   xp = x;
3107   yp = y;
3108   statp = stat;
3109   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
3110     istat = 0;
3111 
3112     if (*thetap == 90.0) {
3113       r = 0.0;
3114     } else if (*thetap > -90.0) {
3115       xi = D2R*(90.0 - *thetap)/2.0;
3116       if (xi < prj->w[4]) {
3117         r = xi*prj->w[3];
3118       } else {
3119         cosxi = cosd((90.0 - *thetap)/2.0);
3120         tanxi = sqrt(1.0 - cosxi*cosxi)/cosxi;
3121         r = -prj->w[0]*(log(cosxi)/tanxi + prj->w[1]*tanxi);
3122       }
3123     } else {
3124       r = 0.0;
3125       istat = 1;
3126       if (!status) status = PRJERR_BAD_WORLD_SET("airs2x");
3127     }
3128 
3129     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
3130       *xp =  r*(*xp) - prj->x0;
3131       *yp = -r*(*yp) - prj->y0;
3132       *(statp++) = istat;
3133     }
3134   }
3135 
3136   return status;
3137 }
3138 
3139 /*============================================================================
3140 *   CYP: cylindrical perspective projection.
3141 *
3142 *   Given:
3143 *      prj->pv[1]   Distance of point of projection from the centre of the
3144 *                   generating sphere, mu, in units of r0.
3145 *      prj->pv[2]   Radius of the cylinder of projection, lambda, in units of
3146 *                   r0.
3147 *
3148 *   Given and/or returned:
3149 *      prj->r0      Reset to 180/pi if 0.
3150 *      prj->phi0    Reset to 0.0 if undefined.
3151 *      prj->theta0  Reset to 0.0 if undefined.
3152 *
3153 *   Returned:
3154 *      prj->flag     CYP
3155 *      prj->code    "CYP"
3156 *      prj->x0      Fiducial offset in x.
3157 *      prj->y0      Fiducial offset in y.
3158 *      prj->w[0]    r0*lambda*(pi/180)
3159 *      prj->w[1]    (180/pi)/(r0*lambda)
3160 *      prj->w[2]    r0*(mu + lambda)
3161 *      prj->w[3]    1/(r0*(mu + lambda))
3162 *      prj->prjx2s  Pointer to cypx2s().
3163 *      prj->prjs2x  Pointer to cyps2x().
3164 *===========================================================================*/
3165 
cypset(struct prjprm * prj)3166 int cypset(struct prjprm *prj)
3167 
3168 {
3169   if (prj == 0x0) return PRJERR_NULL_POINTER;
3170 
3171   prj->flag = CYP;
3172   strcpy(prj->code, "CYP");
3173 
3174   if (undefined(prj->pv[1])) prj->pv[1] = 1.0;
3175   if (undefined(prj->pv[2])) prj->pv[2] = 1.0;
3176 
3177   strcpy(prj->name, "cylindrical perspective");
3178   prj->category  = CYLINDRICAL;
3179   prj->pvrange   = 102;
3180   prj->simplezen = 0;
3181   prj->equiareal = 0;
3182   prj->conformal = 0;
3183   prj->global    = prj->pv[1] < -1.0 || 0.0 < prj->pv[1];
3184   prj->divergent = !prj->global;
3185 
3186   if (prj->r0 == 0.0) {
3187     prj->r0 = R2D;
3188 
3189     prj->w[0] = prj->pv[2];
3190     if (prj->w[0] == 0.0) {
3191       return PRJERR_BAD_PARAM_SET("cypset");
3192     }
3193 
3194     prj->w[1] = 1.0/prj->w[0];
3195 
3196     prj->w[2] = R2D*(prj->pv[1] + prj->pv[2]);
3197     if (prj->w[2] == 0.0) {
3198       return PRJERR_BAD_PARAM_SET("cypset");
3199     }
3200 
3201     prj->w[3] = 1.0/prj->w[2];
3202   } else {
3203     prj->w[0] = prj->r0*prj->pv[2]*D2R;
3204     if (prj->w[0] == 0.0) {
3205       return PRJERR_BAD_PARAM_SET("cypset");
3206     }
3207 
3208     prj->w[1] = 1.0/prj->w[0];
3209 
3210     prj->w[2] = prj->r0*(prj->pv[1] + prj->pv[2]);
3211     if (prj->w[2] == 0.0) {
3212       return PRJERR_BAD_PARAM_SET("cypset");
3213     }
3214 
3215     prj->w[3] = 1.0/prj->w[2];
3216   }
3217 
3218   prj->prjx2s = cypx2s;
3219   prj->prjs2x = cyps2x;
3220 
3221   return prjoff(prj, 0.0, 0.0);
3222 }
3223 
3224 //----------------------------------------------------------------------------
3225 
cypx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])3226 int cypx2s(
3227   struct prjprm *prj,
3228   int nx,
3229   int ny,
3230   int sxy,
3231   int spt,
3232   const double x[],
3233   const double y[],
3234   double phi[],
3235   double theta[],
3236   int stat[])
3237 
3238 {
3239   int mx, my, rowlen, rowoff, status;
3240   double eta, s, t;
3241   register int ix, iy, *statp;
3242   register const double *xp, *yp;
3243   register double *phip, *thetap;
3244 
3245 
3246   // Initialize.
3247   if (prj == 0x0) return PRJERR_NULL_POINTER;
3248   if (prj->flag != CYP) {
3249     if ((status = cypset(prj))) return status;
3250   }
3251 
3252   if (ny > 0) {
3253     mx = nx;
3254     my = ny;
3255   } else {
3256     mx = 1;
3257     my = 1;
3258     ny = nx;
3259   }
3260 
3261   status = 0;
3262 
3263 
3264   // Do x dependence.
3265   xp = x;
3266   rowoff = 0;
3267   rowlen = nx*spt;
3268   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
3269     s = prj->w[1]*(*xp + prj->x0);
3270 
3271     phip = phi + rowoff;
3272     for (iy = 0; iy < my; iy++) {
3273       *phip = s;
3274       phip += rowlen;
3275     }
3276   }
3277 
3278 
3279   // Do y dependence.
3280   yp = y;
3281   thetap = theta;
3282   statp = stat;
3283   for (iy = 0; iy < ny; iy++, yp += sxy) {
3284     eta = prj->w[3]*(*yp + prj->y0);
3285     t = atan2d(eta,1.0) + asind(eta*prj->pv[1]/sqrt(eta*eta+1.0));
3286 
3287     for (ix = 0; ix < mx; ix++, thetap += spt) {
3288       *thetap = t;
3289       *(statp++) = 0;
3290     }
3291   }
3292 
3293 
3294   // Do bounds checking on the native coordinates.
3295   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
3296     if (!status) status = PRJERR_BAD_PIX_SET("cypx2s");
3297   }
3298 
3299   return status;
3300 }
3301 
3302 //----------------------------------------------------------------------------
3303 
cyps2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])3304 int cyps2x(
3305   struct prjprm *prj,
3306   int nphi,
3307   int ntheta,
3308   int spt,
3309   int sxy,
3310   const double phi[],
3311   const double theta[],
3312   double x[],
3313   double y[],
3314   int stat[])
3315 
3316 {
3317   int mphi, mtheta, rowlen, rowoff, status;
3318   double eta, xi;
3319   register int iphi, itheta, istat, *statp;
3320   register const double *phip, *thetap;
3321   register double *xp, *yp;
3322 
3323 
3324   // Initialize.
3325   if (prj == 0x0) return PRJERR_NULL_POINTER;
3326   if (prj->flag != CYP) {
3327     if ((status = cypset(prj))) return status;
3328   }
3329 
3330   if (ntheta > 0) {
3331     mphi   = nphi;
3332     mtheta = ntheta;
3333   } else {
3334     mphi   = 1;
3335     mtheta = 1;
3336     ntheta = nphi;
3337   }
3338 
3339   status = 0;
3340 
3341 
3342   // Do phi dependence.
3343   phip = phi;
3344   rowoff = 0;
3345   rowlen = nphi*sxy;
3346   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
3347     xi = prj->w[0]*(*phip) - prj->x0;
3348 
3349     xp = x + rowoff;
3350     for (itheta = 0; itheta < mtheta; itheta++) {
3351       *xp = xi;
3352       xp += rowlen;
3353     }
3354   }
3355 
3356 
3357   // Do theta dependence.
3358   thetap = theta;
3359   yp = y;
3360   statp = stat;
3361   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
3362     eta = prj->pv[1] + cosd(*thetap);
3363 
3364     istat = 0;
3365     if (eta == 0.0) {
3366       istat = 1;
3367       if (!status) status = PRJERR_BAD_WORLD_SET("cyps2x");
3368 
3369     } else {
3370       eta = prj->w[2]*sind(*thetap)/eta;
3371     }
3372 
3373     eta -= prj->y0;
3374     for (iphi = 0; iphi < mphi; iphi++, yp += sxy) {
3375       *yp = eta;
3376       *(statp++) = istat;
3377     }
3378   }
3379 
3380   return status;
3381 }
3382 
3383 /*============================================================================
3384 *   CEA: cylindrical equal area projection.
3385 *
3386 *   Given:
3387 *      prj->pv[1]   Square of the cosine of the latitude at which the
3388 *                   projection is conformal, lambda.
3389 *
3390 *   Given and/or returned:
3391 *      prj->r0      Reset to 180/pi if 0.
3392 *      prj->phi0    Reset to 0.0 if undefined.
3393 *      prj->theta0  Reset to 0.0 if undefined.
3394 *
3395 *   Returned:
3396 *      prj->flag     CEA
3397 *      prj->code    "CEA"
3398 *      prj->x0      Fiducial offset in x.
3399 *      prj->y0      Fiducial offset in y.
3400 *      prj->w[0]    r0*(pi/180)
3401 *      prj->w[1]    (180/pi)/r0
3402 *      prj->w[2]    r0/lambda
3403 *      prj->w[3]    lambda/r0
3404 *      prj->prjx2s  Pointer to ceax2s().
3405 *      prj->prjs2x  Pointer to ceas2x().
3406 *===========================================================================*/
3407 
ceaset(struct prjprm * prj)3408 int ceaset(struct prjprm *prj)
3409 
3410 {
3411   if (prj == 0x0) return PRJERR_NULL_POINTER;
3412 
3413   prj->flag = CEA;
3414   strcpy(prj->code, "CEA");
3415 
3416   if (undefined(prj->pv[1])) prj->pv[1] = 1.0;
3417 
3418   strcpy(prj->name, "cylindrical equal area");
3419   prj->category  = CYLINDRICAL;
3420   prj->pvrange   = 101;
3421   prj->simplezen = 0;
3422   prj->equiareal = 1;
3423   prj->conformal = 0;
3424   prj->global    = 1;
3425   prj->divergent = 0;
3426 
3427   if (prj->r0 == 0.0) {
3428     prj->r0 = R2D;
3429     prj->w[0] = 1.0;
3430     prj->w[1] = 1.0;
3431     if (prj->pv[1] <= 0.0 || prj->pv[1] > 1.0) {
3432       return PRJERR_BAD_PARAM_SET("ceaset");
3433     }
3434     prj->w[2] = prj->r0/prj->pv[1];
3435     prj->w[3] = prj->pv[1]/prj->r0;
3436   } else {
3437     prj->w[0] = prj->r0*D2R;
3438     prj->w[1] = R2D/prj->r0;
3439     if (prj->pv[1] <= 0.0 || prj->pv[1] > 1.0) {
3440       return PRJERR_BAD_PARAM_SET("ceaset");
3441     }
3442     prj->w[2] = prj->r0/prj->pv[1];
3443     prj->w[3] = prj->pv[1]/prj->r0;
3444   }
3445 
3446   prj->prjx2s = ceax2s;
3447   prj->prjs2x = ceas2x;
3448 
3449   return prjoff(prj, 0.0, 0.0);
3450 }
3451 
3452 //----------------------------------------------------------------------------
3453 
ceax2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])3454 int ceax2s(
3455   struct prjprm *prj,
3456   int nx,
3457   int ny,
3458   int sxy,
3459   int spt,
3460   const double x[],
3461   const double y[],
3462   double phi[],
3463   double theta[],
3464   int stat[])
3465 
3466 {
3467   int mx, my, rowlen, rowoff, status;
3468   double s;
3469   const double tol = 1.0e-13;
3470   register int istat, ix, iy, *statp;
3471   register const double *xp, *yp;
3472   register double *phip, *thetap;
3473 
3474 
3475   // Initialize.
3476   if (prj == 0x0) return PRJERR_NULL_POINTER;
3477   if (prj->flag != CEA) {
3478     if ((status = ceaset(prj))) return status;
3479   }
3480 
3481   if (ny > 0) {
3482     mx = nx;
3483     my = ny;
3484   } else {
3485     mx = 1;
3486     my = 1;
3487     ny = nx;
3488   }
3489 
3490   status = 0;
3491 
3492 
3493   // Do x dependence.
3494   xp = x;
3495   rowoff = 0;
3496   rowlen = nx*spt;
3497   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
3498     s = prj->w[1]*(*xp + prj->x0);
3499 
3500     phip = phi + rowoff;
3501     for (iy = 0; iy < my; iy++) {
3502       *phip = s;
3503       phip += rowlen;
3504     }
3505   }
3506 
3507 
3508   // Do y dependence.
3509   yp = y;
3510   thetap = theta;
3511   statp = stat;
3512   for (iy = 0; iy < ny; iy++, yp += sxy) {
3513     s = prj->w[3]*(*yp + prj->y0);
3514 
3515     istat = 0;
3516     if (fabs(s) > 1.0) {
3517       if (fabs(s) > 1.0+tol) {
3518         s = 0.0;
3519         istat = 1;
3520         if (!status) status = PRJERR_BAD_PIX_SET("ceax2s");
3521       } else {
3522         s = copysign(90.0, s);
3523       }
3524     } else {
3525       s = asind(s);
3526     }
3527 
3528     for (ix = 0; ix < mx; ix++, thetap += spt) {
3529       *thetap = s;
3530       *(statp++) = istat;
3531     }
3532   }
3533 
3534 
3535   // Do bounds checking on the native coordinates.
3536   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
3537     if (!status) status = PRJERR_BAD_PIX_SET("ceax2s");
3538   }
3539 
3540   return status;
3541 }
3542 
3543 //----------------------------------------------------------------------------
3544 
ceas2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])3545 int ceas2x(
3546   struct prjprm *prj,
3547   int nphi,
3548   int ntheta,
3549   int spt,
3550   int sxy,
3551   const double phi[],
3552   const double theta[],
3553   double x[],
3554   double y[],
3555   int stat[])
3556 
3557 {
3558   int mphi, mtheta, rowlen, rowoff, status;
3559   double eta, xi;
3560   register int iphi, itheta, *statp;
3561   register const double *phip, *thetap;
3562   register double *xp, *yp;
3563 
3564 
3565   // Initialize.
3566   if (prj == 0x0) return PRJERR_NULL_POINTER;
3567   if (prj->flag != CEA) {
3568     if ((status = ceaset(prj))) return status;
3569   }
3570 
3571   if (ntheta > 0) {
3572     mphi   = nphi;
3573     mtheta = ntheta;
3574   } else {
3575     mphi   = 1;
3576     mtheta = 1;
3577     ntheta = nphi;
3578   }
3579 
3580 
3581   // Do phi dependence.
3582   phip = phi;
3583   rowoff = 0;
3584   rowlen = nphi*sxy;
3585   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
3586     xi = prj->w[0]*(*phip) - prj->x0;
3587 
3588     xp = x + rowoff;
3589     for (itheta = 0; itheta < mtheta; itheta++) {
3590       *xp = xi;
3591       xp += rowlen;
3592     }
3593   }
3594 
3595 
3596   // Do theta dependence.
3597   thetap = theta;
3598   yp = y;
3599   statp = stat;
3600   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
3601     eta = prj->w[2]*sind(*thetap) - prj->y0;
3602 
3603     for (iphi = 0; iphi < mphi; iphi++, yp += sxy) {
3604       *yp = eta;
3605       *(statp++) = 0;
3606     }
3607   }
3608 
3609   return 0;
3610 }
3611 
3612 /*============================================================================
3613 *   CAR: Plate carree projection.
3614 *
3615 *   Given and/or returned:
3616 *      prj->r0      Reset to 180/pi if 0.
3617 *      prj->phi0    Reset to 0.0 if undefined.
3618 *      prj->theta0  Reset to 0.0 if undefined.
3619 *
3620 *   Returned:
3621 *      prj->flag     CAR
3622 *      prj->code    "CAR"
3623 *      prj->x0      Fiducial offset in x.
3624 *      prj->y0      Fiducial offset in y.
3625 *      prj->w[0]    r0*(pi/180)
3626 *      prj->w[1]    (180/pi)/r0
3627 *      prj->prjx2s  Pointer to carx2s().
3628 *      prj->prjs2x  Pointer to cars2x().
3629 *===========================================================================*/
3630 
carset(struct prjprm * prj)3631 int carset(struct prjprm *prj)
3632 
3633 {
3634   if (prj == 0x0) return PRJERR_NULL_POINTER;
3635 
3636   prj->flag = CAR;
3637   strcpy(prj->code, "CAR");
3638 
3639   strcpy(prj->name, "plate caree");
3640   prj->category  = CYLINDRICAL;
3641   prj->pvrange   = 0;
3642   prj->simplezen = 0;
3643   prj->equiareal = 0;
3644   prj->conformal = 0;
3645   prj->global    = 1;
3646   prj->divergent = 0;
3647 
3648   if (prj->r0 == 0.0) {
3649     prj->r0 = R2D;
3650     prj->w[0] = 1.0;
3651     prj->w[1] = 1.0;
3652   } else {
3653     prj->w[0] = prj->r0*D2R;
3654     prj->w[1] = 1.0/prj->w[0];
3655   }
3656 
3657   prj->prjx2s = carx2s;
3658   prj->prjs2x = cars2x;
3659 
3660   return prjoff(prj, 0.0, 0.0);
3661 }
3662 
3663 //----------------------------------------------------------------------------
3664 
carx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])3665 int carx2s(
3666   struct prjprm *prj,
3667   int nx,
3668   int ny,
3669   int sxy,
3670   int spt,
3671   const double x[],
3672   const double y[],
3673   double phi[],
3674   double theta[],
3675   int stat[])
3676 
3677 {
3678   int mx, my, rowlen, rowoff, status;
3679   double s, t;
3680   register int ix, iy, *statp;
3681   register const double *xp, *yp;
3682   register double *phip, *thetap;
3683 
3684 
3685   // Initialize.
3686   if (prj == 0x0) return PRJERR_NULL_POINTER;
3687   if (prj->flag != CAR) {
3688     if ((status = carset(prj))) return status;
3689   }
3690 
3691   if (ny > 0) {
3692     mx = nx;
3693     my = ny;
3694   } else {
3695     mx = 1;
3696     my = 1;
3697     ny = nx;
3698   }
3699 
3700   status = 0;
3701 
3702 
3703   // Do x dependence.
3704   xp = x;
3705   rowoff = 0;
3706   rowlen = nx*spt;
3707   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
3708     s = prj->w[1]*(*xp + prj->x0);
3709 
3710     phip = phi + rowoff;
3711     for (iy = 0; iy < my; iy++) {
3712       *phip = s;
3713       phip += rowlen;
3714     }
3715   }
3716 
3717 
3718   // Do y dependence.
3719   yp = y;
3720   thetap = theta;
3721   statp = stat;
3722   for (iy = 0; iy < ny; iy++, yp += sxy) {
3723     t = prj->w[1]*(*yp + prj->y0);
3724 
3725     for (ix = 0; ix < mx; ix++, thetap += spt) {
3726       *thetap = t;
3727       *(statp++) = 0;
3728     }
3729   }
3730 
3731 
3732   // Do bounds checking on the native coordinates.
3733   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
3734     if (!status) status = PRJERR_BAD_PIX_SET("carx2s");
3735   }
3736 
3737   return status;
3738 }
3739 
3740 //----------------------------------------------------------------------------
3741 
cars2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])3742 int cars2x(
3743   struct prjprm *prj,
3744   int nphi,
3745   int ntheta,
3746   int spt,
3747   int sxy,
3748   const double phi[],
3749   const double theta[],
3750   double x[],
3751   double y[],
3752   int stat[])
3753 
3754 {
3755   int mphi, mtheta, rowlen, rowoff, status;
3756   double eta, xi;
3757   register int iphi, itheta, *statp;
3758   register const double *phip, *thetap;
3759   register double *xp, *yp;
3760 
3761 
3762   // Initialize.
3763   if (prj == 0x0) return PRJERR_NULL_POINTER;
3764   if (prj->flag != CAR) {
3765     if ((status = carset(prj))) return status;
3766   }
3767 
3768   if (ntheta > 0) {
3769     mphi   = nphi;
3770     mtheta = ntheta;
3771   } else {
3772     mphi   = 1;
3773     mtheta = 1;
3774     ntheta = nphi;
3775   }
3776 
3777 
3778   // Do phi dependence.
3779   phip = phi;
3780   rowoff = 0;
3781   rowlen = nphi*sxy;
3782   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
3783     xi = prj->w[0]*(*phip) - prj->x0;
3784 
3785     xp = x + rowoff;
3786     for (itheta = 0; itheta < mtheta; itheta++) {
3787       *xp = xi;
3788       xp += rowlen;
3789     }
3790   }
3791 
3792 
3793   // Do theta dependence.
3794   thetap = theta;
3795   yp = y;
3796   statp = stat;
3797   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
3798     eta = prj->w[0]*(*thetap) - prj->y0;
3799 
3800     for (iphi = 0; iphi < mphi; iphi++, yp += sxy) {
3801       *yp = eta;
3802       *(statp++) = 0;
3803     }
3804   }
3805 
3806   return 0;
3807 }
3808 
3809 /*============================================================================
3810 *   MER: Mercator's projection.
3811 *
3812 *   Given and/or returned:
3813 *      prj->r0      Reset to 180/pi if 0.
3814 *      prj->phi0    Reset to 0.0 if undefined.
3815 *      prj->theta0  Reset to 0.0 if undefined.
3816 *
3817 *   Returned:
3818 *      prj->flag     MER
3819 *      prj->code    "MER"
3820 *      prj->x0      Fiducial offset in x.
3821 *      prj->y0      Fiducial offset in y.
3822 *      prj->w[0]    r0*(pi/180)
3823 *      prj->w[1]    (180/pi)/r0
3824 *      prj->prjx2s  Pointer to merx2s().
3825 *      prj->prjs2x  Pointer to mers2x().
3826 *===========================================================================*/
3827 
merset(struct prjprm * prj)3828 int merset(struct prjprm *prj)
3829 
3830 {
3831   if (prj == 0x0) return PRJERR_NULL_POINTER;
3832 
3833   prj->flag = MER;
3834   strcpy(prj->code, "MER");
3835 
3836   strcpy(prj->name, "Mercator's");
3837   prj->category  = CYLINDRICAL;
3838   prj->pvrange   = 0;
3839   prj->simplezen = 0;
3840   prj->equiareal = 0;
3841   prj->conformal = 1;
3842   prj->global    = 0;
3843   prj->divergent = 1;
3844 
3845   if (prj->r0 == 0.0) {
3846     prj->r0 = R2D;
3847     prj->w[0] = 1.0;
3848     prj->w[1] = 1.0;
3849   } else {
3850     prj->w[0] = prj->r0*D2R;
3851     prj->w[1] = 1.0/prj->w[0];
3852   }
3853 
3854   prj->prjx2s = merx2s;
3855   prj->prjs2x = mers2x;
3856 
3857   return prjoff(prj, 0.0, 0.0);
3858 }
3859 
3860 //----------------------------------------------------------------------------
3861 
merx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])3862 int merx2s(
3863   struct prjprm *prj,
3864   int nx,
3865   int ny,
3866   int sxy,
3867   int spt,
3868   const double x[],
3869   const double y[],
3870   double phi[],
3871   double theta[],
3872   int stat[])
3873 
3874 {
3875   int mx, my, rowlen, rowoff, status;
3876   double s, t;
3877   register int ix, iy, *statp;
3878   register const double *xp, *yp;
3879   register double *phip, *thetap;
3880 
3881 
3882   // Initialize.
3883   if (prj == 0x0) return PRJERR_NULL_POINTER;
3884   if (prj->flag != MER) {
3885     if ((status = merset(prj))) return status;
3886   }
3887 
3888   if (ny > 0) {
3889     mx = nx;
3890     my = ny;
3891   } else {
3892     mx = 1;
3893     my = 1;
3894     ny = nx;
3895   }
3896 
3897   status = 0;
3898 
3899 
3900   // Do x dependence.
3901   xp = x;
3902   rowoff = 0;
3903   rowlen = nx*spt;
3904   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
3905     s = prj->w[1]*(*xp + prj->x0);
3906 
3907     phip = phi + rowoff;
3908     for (iy = 0; iy < my; iy++) {
3909       *phip = s;
3910       phip += rowlen;
3911     }
3912   }
3913 
3914 
3915   // Do y dependence.
3916   yp = y;
3917   thetap = theta;
3918   statp  = stat;
3919   for (iy = 0; iy < ny; iy++, yp += sxy) {
3920     t = 2.0*atand(exp((*yp + prj->y0)/prj->r0)) - 90.0;
3921 
3922     for (ix = 0; ix < mx; ix++, thetap += spt) {
3923       *thetap = t;
3924       *(statp++) = 0;
3925     }
3926   }
3927 
3928 
3929   // Do bounds checking on the native coordinates.
3930   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
3931     if (!status) status = PRJERR_BAD_PIX_SET("merx2s");
3932   }
3933 
3934   return status;
3935 }
3936 
3937 //----------------------------------------------------------------------------
3938 
mers2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])3939 int mers2x(
3940   struct prjprm *prj,
3941   int nphi,
3942   int ntheta,
3943   int spt,
3944   int sxy,
3945   const double phi[],
3946   const double theta[],
3947   double x[],
3948   double y[],
3949   int stat[])
3950 
3951 {
3952   int mphi, mtheta, rowlen, rowoff, status;
3953   double eta, xi;
3954   register int iphi, itheta, istat, *statp;
3955   register const double *phip, *thetap;
3956   register double *xp, *yp;
3957 
3958 
3959   // Initialize.
3960   if (prj == 0x0) return PRJERR_NULL_POINTER;
3961   if (prj->flag != MER) {
3962     if ((status = merset(prj))) return status;
3963   }
3964 
3965   if (ntheta > 0) {
3966     mphi   = nphi;
3967     mtheta = ntheta;
3968   } else {
3969     mphi   = 1;
3970     mtheta = 1;
3971     ntheta = nphi;
3972   }
3973 
3974   status = 0;
3975 
3976 
3977   // Do phi dependence.
3978   phip = phi;
3979   rowoff = 0;
3980   rowlen = nphi*sxy;
3981   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
3982     xi  = prj->w[0]*(*phip) - prj->x0;
3983 
3984     xp = x + rowoff;
3985     for (itheta = 0; itheta < mtheta; itheta++) {
3986       *xp = xi;
3987       xp += rowlen;
3988     }
3989   }
3990 
3991 
3992   // Do theta dependence.
3993   thetap = theta;
3994   yp = y;
3995   statp = stat;
3996   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
3997     istat = 0;
3998 
3999     if (*thetap <= -90.0 || *thetap >= 90.0) {
4000       eta = 0.0;
4001       istat = 1;
4002       if (!status) status = PRJERR_BAD_WORLD_SET("mers2x");
4003     } else {
4004       eta = prj->r0*log(tand((*thetap+90.0)/2.0)) - prj->y0;
4005     }
4006 
4007     for (iphi = 0; iphi < mphi; iphi++, yp += sxy) {
4008       *yp = eta;
4009       *(statp++) = istat;
4010     }
4011   }
4012 
4013   return status;
4014 }
4015 
4016 /*============================================================================
4017 *   SFL: Sanson-Flamsteed ("global sinusoid") projection.
4018 *
4019 *   Given and/or returned:
4020 *      prj->r0      Reset to 180/pi if 0.
4021 *      prj->phi0    Reset to 0.0 if undefined.
4022 *      prj->theta0  Reset to 0.0 if undefined.
4023 *
4024 *   Returned:
4025 *      prj->flag     SFL
4026 *      prj->code    "SFL"
4027 *      prj->x0      Fiducial offset in x.
4028 *      prj->y0      Fiducial offset in y.
4029 *      prj->w[0]    r0*(pi/180)
4030 *      prj->w[1]    (180/pi)/r0
4031 *      prj->prjx2s  Pointer to sflx2s().
4032 *      prj->prjs2x  Pointer to sfls2x().
4033 *===========================================================================*/
4034 
sflset(struct prjprm * prj)4035 int sflset(struct prjprm *prj)
4036 
4037 {
4038   if (prj == 0x0) return PRJERR_NULL_POINTER;
4039 
4040   prj->flag = SFL;
4041   strcpy(prj->code, "SFL");
4042 
4043   strcpy(prj->name, "Sanson-Flamsteed");
4044   prj->category  = PSEUDOCYLINDRICAL;
4045   prj->pvrange   = 0;
4046   prj->simplezen = 0;
4047   prj->equiareal = 1;
4048   prj->conformal = 0;
4049   prj->global    = 1;
4050   prj->divergent = 0;
4051 
4052   if (prj->r0 == 0.0) {
4053     prj->r0 = R2D;
4054     prj->w[0] = 1.0;
4055     prj->w[1] = 1.0;
4056   } else {
4057     prj->w[0] = prj->r0*D2R;
4058     prj->w[1] = 1.0/prj->w[0];
4059   }
4060 
4061   prj->prjx2s = sflx2s;
4062   prj->prjs2x = sfls2x;
4063 
4064   return prjoff(prj, 0.0, 0.0);
4065 }
4066 
4067 //----------------------------------------------------------------------------
4068 
sflx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])4069 int sflx2s(
4070   struct prjprm *prj,
4071   int nx,
4072   int ny,
4073   int sxy,
4074   int spt,
4075   const double x[],
4076   const double y[],
4077   double phi[],
4078   double theta[],
4079   int stat[])
4080 
4081 {
4082   int mx, my, rowlen, rowoff, status;
4083   double s, t, yj;
4084   register int istat, ix, iy, *statp;
4085   register const double *xp, *yp;
4086   register double *phip, *thetap;
4087 
4088 
4089   // Initialize.
4090   if (prj == 0x0) return PRJERR_NULL_POINTER;
4091   if (prj->flag != SFL) {
4092     if ((status = sflset(prj))) return status;
4093   }
4094 
4095   if (ny > 0) {
4096     mx = nx;
4097     my = ny;
4098   } else {
4099     mx = 1;
4100     my = 1;
4101     ny = nx;
4102   }
4103 
4104   status = 0;
4105 
4106 
4107   // Do x dependence.
4108   xp = x;
4109   rowoff = 0;
4110   rowlen = nx*spt;
4111   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
4112     s = prj->w[1]*(*xp + prj->x0);
4113 
4114     phip = phi + rowoff;
4115     for (iy = 0; iy < my; iy++) {
4116       *phip = s;
4117       phip += rowlen;
4118     }
4119   }
4120 
4121 
4122   // Do y dependence.
4123   yp = y;
4124   phip   = phi;
4125   thetap = theta;
4126   statp  = stat;
4127   for (iy = 0; iy < ny; iy++, yp += sxy) {
4128     yj = *yp + prj->y0;
4129     s = cos(yj/prj->r0);
4130 
4131     istat = 0;
4132     if (s == 0.0) {
4133       istat = 1;
4134       if (!status) status = PRJERR_BAD_PIX_SET("sflx2s");
4135     } else {
4136       s = 1.0/s;
4137     }
4138 
4139     t = prj->w[1]*yj;
4140 
4141     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
4142       *phip  *= s;
4143       *thetap = t;
4144       *(statp++) = istat;
4145     }
4146   }
4147 
4148 
4149   // Do bounds checking on the native coordinates.
4150   if (prj->bounds&4 && prjbchk(1.0e-12, nx, my, spt, phi, theta, stat)) {
4151     if (!status) status = PRJERR_BAD_PIX_SET("sflx2s");
4152   }
4153 
4154   return status;
4155 }
4156 
4157 //----------------------------------------------------------------------------
4158 
sfls2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])4159 int sfls2x(
4160   struct prjprm *prj,
4161   int nphi,
4162   int ntheta,
4163   int spt,
4164   int sxy,
4165   const double phi[],
4166   const double theta[],
4167   double x[],
4168   double y[],
4169   int stat[])
4170 
4171 {
4172   int mphi, mtheta, rowlen, rowoff, status;
4173   double eta, xi;
4174   register int iphi, itheta, *statp;
4175   register const double *phip, *thetap;
4176   register double *xp, *yp;
4177 
4178 
4179   // Initialize.
4180   if (prj == 0x0) return PRJERR_NULL_POINTER;
4181   if (prj->flag != SFL) {
4182     if ((status = sflset(prj))) return status;
4183   }
4184 
4185   if (ntheta > 0) {
4186     mphi   = nphi;
4187     mtheta = ntheta;
4188   } else {
4189     mphi   = 1;
4190     mtheta = 1;
4191     ntheta = nphi;
4192   }
4193 
4194 
4195   // Do phi dependence.
4196   phip = phi;
4197   rowoff = 0;
4198   rowlen = nphi*sxy;
4199   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
4200     xi = prj->w[0]*(*phip);
4201 
4202     xp = x + rowoff;
4203     for (itheta = 0; itheta < mtheta; itheta++) {
4204       *xp = xi;
4205       xp += rowlen;
4206     }
4207   }
4208 
4209 
4210   // Do theta dependence.
4211   thetap = theta;
4212   xp = x;
4213   yp = y;
4214   statp = stat;
4215   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
4216     xi  = cosd(*thetap);
4217     eta = prj->w[0]*(*thetap) - prj->y0;
4218 
4219     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
4220       *xp = xi*(*xp) - prj->x0;
4221       *yp = eta;
4222       *(statp++) = 0;
4223     }
4224   }
4225 
4226   return 0;
4227 }
4228 
4229 /*============================================================================
4230 *   PAR: parabolic projection.
4231 *
4232 *   Given and/or returned:
4233 *      prj->r0      Reset to 180/pi if 0.
4234 *      prj->phi0    Reset to 0.0 if undefined.
4235 *      prj->theta0  Reset to 0.0 if undefined.
4236 *
4237 *   Returned:
4238 *      prj->flag     PAR
4239 *      prj->code    "PAR"
4240 *      prj->x0      Fiducial offset in x.
4241 *      prj->y0      Fiducial offset in y.
4242 *      prj->w[0]    r0*(pi/180)
4243 *      prj->w[1]    (180/pi)/r0
4244 *      prj->w[2]    pi*r0
4245 *      prj->w[3]    1/(pi*r0)
4246 *      prj->prjx2s  Pointer to parx2s().
4247 *      prj->prjs2x  Pointer to pars2x().
4248 *===========================================================================*/
4249 
parset(struct prjprm * prj)4250 int parset(struct prjprm *prj)
4251 
4252 {
4253   if (prj == 0x0) return PRJERR_NULL_POINTER;
4254 
4255   prj->flag = PAR;
4256   strcpy(prj->code, "PAR");
4257 
4258   strcpy(prj->name, "parabolic");
4259   prj->category  = PSEUDOCYLINDRICAL;
4260   prj->pvrange   = 0;
4261   prj->simplezen = 0;
4262   prj->equiareal = 1;
4263   prj->conformal = 0;
4264   prj->global    = 1;
4265   prj->divergent = 0;
4266 
4267   if (prj->r0 == 0.0) {
4268     prj->r0 = R2D;
4269     prj->w[0] = 1.0;
4270     prj->w[1] = 1.0;
4271     prj->w[2] = 180.0;
4272     prj->w[3] = 1.0/prj->w[2];
4273   } else {
4274     prj->w[0] = prj->r0*D2R;
4275     prj->w[1] = 1.0/prj->w[0];
4276     prj->w[2] = PI*prj->r0;
4277     prj->w[3] = 1.0/prj->w[2];
4278   }
4279 
4280   prj->prjx2s = parx2s;
4281   prj->prjs2x = pars2x;
4282 
4283   return prjoff(prj, 0.0, 0.0);
4284 }
4285 
4286 //----------------------------------------------------------------------------
4287 
parx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])4288 int parx2s(
4289   struct prjprm *prj,
4290   int nx,
4291   int ny,
4292   int sxy,
4293   int spt,
4294   const double x[],
4295   const double y[],
4296   double phi[],
4297   double theta[],
4298   int stat[])
4299 
4300 {
4301   int mx, my, rowlen, rowoff, status;
4302   double r, s, t, xj;
4303   const double tol = 1.0e-13;
4304   register int istat, ix, iy, *statp;
4305   register const double *xp, *yp;
4306   register double *phip, *thetap;
4307 
4308 
4309   // Initialize.
4310   if (prj == 0x0) return PRJERR_NULL_POINTER;
4311   if (prj->flag != PAR) {
4312     if ((status = parset(prj))) return status;
4313   }
4314 
4315   if (ny > 0) {
4316     mx = nx;
4317     my = ny;
4318   } else {
4319     mx = 1;
4320     my = 1;
4321     ny = nx;
4322   }
4323 
4324   status = 0;
4325 
4326 
4327   // Do x dependence.
4328   xp = x;
4329   rowoff = 0;
4330   rowlen = nx*spt;
4331   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
4332     xj = *xp + prj->x0;
4333     s = prj->w[1]*xj;
4334     t = fabs(xj) - tol;
4335 
4336     phip   = phi   + rowoff;
4337     thetap = theta + rowoff;
4338     for (iy = 0; iy < my; iy++) {
4339       *phip   = s;
4340       *thetap = t;
4341       phip   += rowlen;
4342       thetap += rowlen;
4343     }
4344   }
4345 
4346 
4347   // Do y dependence.
4348   yp = y;
4349   phip   = phi;
4350   thetap = theta;
4351   statp  = stat;
4352   for (iy = 0; iy < ny; iy++, yp += sxy) {
4353     r = prj->w[3]*(*yp + prj->y0);
4354 
4355     istat = 0;
4356     if (r > 1.0 || r < -1.0) {
4357       s = 0.0;
4358       t = 0.0;
4359       istat = 1;
4360       if (!status) status = PRJERR_BAD_PIX_SET("parx2s");
4361 
4362     } else {
4363       s = 1.0 - 4.0*r*r;
4364       if (s == 0.0) {
4365         // Deferred test.
4366         istat = -1;
4367       } else {
4368         s = 1.0/s;
4369       }
4370 
4371       t = 3.0*asind(r);
4372     }
4373 
4374     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
4375       if (istat < 0) {
4376         if (*thetap < 0.0) {
4377           *(statp++) = 0;
4378         } else {
4379           *(statp++) = 1;
4380           if (!status) status = PRJERR_BAD_PIX_SET("parx2s");
4381         }
4382       } else {
4383         *(statp++) = istat;
4384       }
4385 
4386       *phip  *= s;
4387       *thetap = t;
4388     }
4389   }
4390 
4391 
4392   // Do bounds checking on the native coordinates.
4393   if (prj->bounds&4 && prjbchk(1.0e-12, nx, my, spt, phi, theta, stat)) {
4394     if (!status) status = PRJERR_BAD_PIX_SET("parx2s");
4395   }
4396 
4397   return status;
4398 }
4399 
4400 //----------------------------------------------------------------------------
4401 
pars2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])4402 int pars2x(
4403   struct prjprm *prj,
4404   int nphi,
4405   int ntheta,
4406   int spt,
4407   int sxy,
4408   const double phi[],
4409   const double theta[],
4410   double x[],
4411   double y[],
4412   int stat[])
4413 
4414 {
4415   int mphi, mtheta, rowlen, rowoff, status;
4416   double eta, s, xi;
4417   register int iphi, itheta, *statp;
4418   register const double *phip, *thetap;
4419   register double *xp, *yp;
4420 
4421 
4422   // Initialize.
4423   if (prj == 0x0) return PRJERR_NULL_POINTER;
4424   if (prj->flag != PAR) {
4425     if ((status = parset(prj))) return status;
4426   }
4427 
4428   if (ntheta > 0) {
4429     mphi   = nphi;
4430     mtheta = ntheta;
4431   } else {
4432     mphi   = 1;
4433     mtheta = 1;
4434     ntheta = nphi;
4435   }
4436 
4437 
4438   // Do phi dependence.
4439   phip = phi;
4440   rowoff = 0;
4441   rowlen = nphi*sxy;
4442   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
4443     xi = prj->w[0]*(*phip);
4444 
4445     xp = x + rowoff;
4446     for (itheta = 0; itheta < mtheta; itheta++) {
4447       *xp = xi;
4448       xp += rowlen;
4449     }
4450   }
4451 
4452 
4453   // Do theta dependence.
4454   thetap = theta;
4455   xp = x;
4456   yp = y;
4457   statp = stat;
4458   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
4459     s = sind((*thetap)/3.0);
4460     xi = (1.0 - 4.0*s*s);
4461     eta = prj->w[2]*s - prj->y0;
4462 
4463     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
4464       *xp = xi*(*xp) - prj->x0;
4465       *yp = eta;
4466       *(statp++) = 0;
4467     }
4468   }
4469 
4470   return 0;
4471 }
4472 
4473 /*============================================================================
4474 *   MOL: Mollweide's projection.
4475 *
4476 *   Given and/or returned:
4477 *      prj->r0      Reset to 180/pi if 0.
4478 *      prj->phi0    Reset to 0.0 if undefined.
4479 *      prj->theta0  Reset to 0.0 if undefined.
4480 *
4481 *   Returned:
4482 *      prj->flag     MOL
4483 *      prj->code    "MOL"
4484 *      prj->x0      Fiducial offset in x.
4485 *      prj->y0      Fiducial offset in y.
4486 *      prj->w[0]    sqrt(2)*r0
4487 *      prj->w[1]    sqrt(2)*r0/90
4488 *      prj->w[2]    1/(sqrt(2)*r0)
4489 *      prj->w[3]    90/r0
4490 *      prj->prjx2s  Pointer to molx2s().
4491 *      prj->prjs2x  Pointer to mols2x().
4492 *===========================================================================*/
4493 
molset(struct prjprm * prj)4494 int molset(struct prjprm *prj)
4495 
4496 {
4497   if (prj == 0x0) return PRJERR_NULL_POINTER;
4498 
4499   prj->flag = MOL;
4500   strcpy(prj->code, "MOL");
4501 
4502   if (prj->r0 == 0.0) prj->r0 = R2D;
4503 
4504   strcpy(prj->name, "Mollweide's");
4505   prj->category  = PSEUDOCYLINDRICAL;
4506   prj->pvrange   = 0;
4507   prj->simplezen = 0;
4508   prj->equiareal = 1;
4509   prj->conformal = 0;
4510   prj->global    = 1;
4511   prj->divergent = 0;
4512 
4513   prj->w[0] = SQRT2*prj->r0;
4514   prj->w[1] = prj->w[0]/90.0;
4515   prj->w[2] = 1.0/prj->w[0];
4516   prj->w[3] = 90.0/prj->r0;
4517   prj->w[4] = 2.0/PI;
4518 
4519   prj->prjx2s = molx2s;
4520   prj->prjs2x = mols2x;
4521 
4522   return prjoff(prj, 0.0, 0.0);
4523 }
4524 
4525 //----------------------------------------------------------------------------
4526 
molx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])4527 int molx2s(
4528   struct prjprm *prj,
4529   int nx,
4530   int ny,
4531   int sxy,
4532   int spt,
4533   const double x[],
4534   const double y[],
4535   double phi[],
4536   double theta[],
4537   int stat[])
4538 
4539 {
4540   int mx, my, rowlen, rowoff, status;
4541   double r, s, t, xj, y0, yj, z;
4542   const double tol = 1.0e-12;
4543   register int istat, ix, iy, *statp;
4544   register const double *xp, *yp;
4545   register double *phip, *thetap;
4546 
4547 
4548   // Initialize.
4549   if (prj == 0x0) return PRJERR_NULL_POINTER;
4550   if (prj->flag != MOL) {
4551     if ((status = molset(prj))) return status;
4552   }
4553 
4554   if (ny > 0) {
4555     mx = nx;
4556     my = ny;
4557   } else {
4558     mx = 1;
4559     my = 1;
4560     ny = nx;
4561   }
4562 
4563   status = 0;
4564 
4565 
4566   // Do x dependence.
4567   xp = x;
4568   rowoff = 0;
4569   rowlen = nx*spt;
4570   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
4571     xj = *xp + prj->x0;
4572     s = prj->w[3]*xj;
4573     t = fabs(xj) - tol;
4574 
4575     phip   = phi   + rowoff;
4576     thetap = theta + rowoff;
4577     for (iy = 0; iy < my; iy++) {
4578       *phip   = s;
4579       *thetap = t;
4580       phip   += rowlen;
4581       thetap += rowlen;
4582     }
4583   }
4584 
4585 
4586   // Do y dependence.
4587   yp = y;
4588   phip   = phi;
4589   thetap = theta;
4590   statp  = stat;
4591   for (iy = 0; iy < ny; iy++, yp += sxy) {
4592     yj = *yp + prj->y0;
4593     y0 = yj/prj->r0;
4594     r  = 2.0 - y0*y0;
4595 
4596     istat = 0;
4597     if (r <= tol) {
4598       if (r < -tol) {
4599         istat = 1;
4600         if (!status) status = PRJERR_BAD_PIX_SET("molx2s");
4601       } else {
4602         // OK if fabs(x) < tol whence phi = 0.0.
4603         istat = -1;
4604       }
4605 
4606       r = 0.0;
4607       s = 0.0;
4608 
4609     } else {
4610       r = sqrt(r);
4611       s = 1.0/r;
4612     }
4613 
4614     z = yj*prj->w[2];
4615     if (fabs(z) > 1.0) {
4616       if (fabs(z) > 1.0+tol) {
4617         z = 0.0;
4618         istat = 1;
4619         if (!status) status = PRJERR_BAD_PIX_SET("molx2s");
4620       } else {
4621         z = copysign(1.0, z) + y0*r/PI;
4622       }
4623     } else {
4624       z = asin(z)*prj->w[4] + y0*r/PI;
4625     }
4626 
4627     if (fabs(z) > 1.0) {
4628       if (fabs(z) > 1.0+tol) {
4629         z = 0.0;
4630         istat = 1;
4631         if (!status) status = PRJERR_BAD_PIX_SET("molx2s");
4632       } else {
4633         z = copysign(1.0, z);
4634       }
4635     }
4636 
4637     t = asind(z);
4638 
4639     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
4640       if (istat < 0) {
4641         if (*thetap < 0.0) {
4642           *(statp++) = 0;
4643         } else {
4644           *(statp++) = 1;
4645           if (!status) status = PRJERR_BAD_PIX_SET("molx2s");
4646         }
4647       } else {
4648         *(statp++) = istat;
4649       }
4650 
4651       *phip  *= s;
4652       *thetap = t;
4653     }
4654   }
4655 
4656 
4657   // Do bounds checking on the native coordinates.
4658   if (prj->bounds&4 && prjbchk(1.0e-11, nx, my, spt, phi, theta, stat)) {
4659     if (!status) status = PRJERR_BAD_PIX_SET("molx2s");
4660   }
4661 
4662   return status;
4663 }
4664 
4665 //----------------------------------------------------------------------------
4666 
mols2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])4667 int mols2x(
4668   struct prjprm *prj,
4669   int nphi,
4670   int ntheta,
4671   int spt,
4672   int sxy,
4673   const double phi[],
4674   const double theta[],
4675   double x[],
4676   double y[],
4677   int stat[])
4678 
4679 {
4680   int k, mphi, mtheta, rowlen, rowoff, status;
4681   double eta, gamma, resid, u, v, v0, v1, xi;
4682   const double tol = 1.0e-13;
4683   register int iphi, itheta, *statp;
4684   register const double *phip, *thetap;
4685   register double *xp, *yp;
4686 
4687 
4688   // Initialize.
4689   if (prj == 0x0) return PRJERR_NULL_POINTER;
4690   if (prj->flag != MOL) {
4691     if ((status = molset(prj))) return status;
4692   }
4693 
4694   if (ntheta > 0) {
4695     mphi   = nphi;
4696     mtheta = ntheta;
4697   } else {
4698     mphi   = 1;
4699     mtheta = 1;
4700     ntheta = nphi;
4701   }
4702 
4703 
4704   // Do phi dependence.
4705   phip = phi;
4706   rowoff = 0;
4707   rowlen = nphi*sxy;
4708   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
4709     xi = prj->w[1]*(*phip);
4710 
4711     xp = x + rowoff;
4712     for (itheta = 0; itheta < mtheta; itheta++) {
4713       *xp = xi;
4714       xp += rowlen;
4715     }
4716   }
4717 
4718 
4719   // Do theta dependence.
4720   thetap = theta;
4721   xp = x;
4722   yp = y;
4723   statp = stat;
4724   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
4725     if (fabs(*thetap) == 90.0) {
4726       xi  = 0.0;
4727       eta = copysign(prj->w[0], *thetap);
4728 
4729     } else if (*thetap == 0.0) {
4730       xi  = 1.0;
4731       eta = 0.0;
4732 
4733     } else {
4734       u  = PI*sind(*thetap);
4735       v0 = -PI;
4736       v1 =  PI;
4737       v  = u;
4738       for (k = 0; k < 100; k++) {
4739         resid = (v - u) + sin(v);
4740         if (resid < 0.0) {
4741           if (resid > -tol) break;
4742           v0 = v;
4743         } else {
4744           if (resid < tol) break;
4745           v1 = v;
4746         }
4747         v = (v0 + v1)/2.0;
4748       }
4749 
4750       gamma = v/2.0;
4751       xi  = cos(gamma);
4752       eta = prj->w[0]*sin(gamma);
4753     }
4754 
4755     eta -= prj->y0;
4756     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
4757       *xp = xi*(*xp) - prj->x0;
4758       *yp = eta;
4759       *(statp++) = 0;
4760     }
4761   }
4762 
4763   return 0;
4764 }
4765 
4766 /*============================================================================
4767 *   AIT: Hammer-Aitoff projection.
4768 *
4769 *   Given and/or returned:
4770 *      prj->r0      Reset to 180/pi if 0.
4771 *      prj->phi0    Reset to 0.0 if undefined.
4772 *      prj->theta0  Reset to 0.0 if undefined.
4773 *
4774 *   Returned:
4775 *      prj->flag     AIT
4776 *      prj->code    "AIT"
4777 *      prj->x0      Fiducial offset in x.
4778 *      prj->y0      Fiducial offset in y.
4779 *      prj->w[0]    2*r0**2
4780 *      prj->w[1]    1/(2*r0)**2
4781 *      prj->w[2]    1/(4*r0)**2
4782 *      prj->w[3]    1/(2*r0)
4783 *      prj->prjx2s  Pointer to aitx2s().
4784 *      prj->prjs2x  Pointer to aits2x().
4785 *===========================================================================*/
4786 
aitset(struct prjprm * prj)4787 int aitset(struct prjprm *prj)
4788 
4789 {
4790   if (prj == 0x0) return PRJERR_NULL_POINTER;
4791 
4792   prj->flag = AIT;
4793   strcpy(prj->code, "AIT");
4794 
4795   if (prj->r0 == 0.0) prj->r0 = R2D;
4796 
4797   strcpy(prj->name, "Hammer-Aitoff");
4798   prj->category  = CONVENTIONAL;
4799   prj->pvrange   = 0;
4800   prj->simplezen = 0;
4801   prj->equiareal = 1;
4802   prj->conformal = 0;
4803   prj->global    = 1;
4804   prj->divergent = 0;
4805 
4806   prj->w[0] = 2.0*prj->r0*prj->r0;
4807   prj->w[1] = 1.0/(2.0*prj->w[0]);
4808   prj->w[2] = prj->w[1]/4.0;
4809   prj->w[3] = 1.0/(2.0*prj->r0);
4810 
4811   prj->prjx2s = aitx2s;
4812   prj->prjs2x = aits2x;
4813 
4814   return prjoff(prj, 0.0, 0.0);
4815 }
4816 
4817 //----------------------------------------------------------------------------
4818 
aitx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])4819 int aitx2s(
4820   struct prjprm *prj,
4821   int nx,
4822   int ny,
4823   int sxy,
4824   int spt,
4825   const double x[],
4826   const double y[],
4827   double phi[],
4828   double theta[],
4829   int stat[])
4830 
4831 {
4832   int mx, my, rowlen, rowoff, status;
4833   double s, t, x0, xj, y0, yj, yj2, z;
4834   const double tol = 1.0e-13;
4835   register int ix, iy, istat, *statp;
4836   register const double *xp, *yp;
4837   register double *phip, *thetap;
4838 
4839 
4840   // Initialize.
4841   if (prj == 0x0) return PRJERR_NULL_POINTER;
4842   if (prj->flag != AIT) {
4843     if ((status = aitset(prj))) return status;
4844   }
4845 
4846   if (ny > 0) {
4847     mx = nx;
4848     my = ny;
4849   } else {
4850     mx = 1;
4851     my = 1;
4852     ny = nx;
4853   }
4854 
4855   status = 0;
4856 
4857 
4858   // Do x dependence.
4859   xp = x;
4860   rowoff = 0;
4861   rowlen = nx*spt;
4862   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
4863     xj = *xp + prj->x0;
4864     s  = 1.0 - xj*xj*prj->w[2];
4865     t  = xj*prj->w[3];
4866 
4867     phip   = phi   + rowoff;
4868     thetap = theta + rowoff;
4869     for (iy = 0; iy < my; iy++) {
4870       *phip   = s;
4871       *thetap = t;
4872       phip   += rowlen;
4873       thetap += rowlen;
4874     }
4875   }
4876 
4877 
4878   // Do y dependence.
4879   yp = y;
4880   phip   = phi;
4881   thetap = theta;
4882   statp  = stat;
4883   for (iy = 0; iy < ny; iy++, yp += sxy) {
4884     yj  = *yp + prj->y0;
4885     yj2 = yj*yj*prj->w[1];
4886 
4887     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
4888       s = *phip - yj2;
4889 
4890       istat = 0;
4891       if (s < 0.5) {
4892         if (s < 0.5-tol) {
4893           istat = 1;
4894           if (!status) status = PRJERR_BAD_PIX_SET("aitx2s");
4895         }
4896 
4897         s = 0.5;
4898       }
4899 
4900       z = sqrt(s);
4901       x0 = 2.0*z*z - 1.0;
4902       y0 = z*(*thetap);
4903       if (x0 == 0.0 && y0 == 0.0) {
4904         *phip = 0.0;
4905       } else {
4906         *phip = 2.0*atan2d(y0, x0);
4907       }
4908 
4909       t = z*yj/prj->r0;
4910       if (fabs(t) > 1.0) {
4911         if (fabs(t) > 1.0+tol) {
4912           istat = 1;
4913           if (!status) status = PRJERR_BAD_PIX_SET("aitx2s");
4914         }
4915         t = copysign(90.0, t);
4916 
4917       } else {
4918         t = asind(t);
4919       }
4920 
4921       *thetap = t;
4922       *(statp++) = istat;
4923     }
4924   }
4925 
4926 
4927   // Do bounds checking on the native coordinates.
4928   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
4929     if (!status) status = PRJERR_BAD_PIX_SET("aitx2s");
4930   }
4931 
4932   return status;
4933 }
4934 
4935 //----------------------------------------------------------------------------
4936 
aits2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])4937 int aits2x(
4938   struct prjprm *prj,
4939   int nphi,
4940   int ntheta,
4941   int spt,
4942   int sxy,
4943   const double phi[],
4944   const double theta[],
4945   double x[],
4946   double y[],
4947   int stat[])
4948 
4949 {
4950   int mphi, mtheta, rowlen, rowoff, status;
4951   double cosphi, costhe, sinphi, sinthe, w;
4952   register int iphi, itheta, *statp;
4953   register const double *phip, *thetap;
4954   register double *xp, *yp;
4955 
4956 
4957   // Initialize.
4958   if (prj == 0x0) return PRJERR_NULL_POINTER;
4959   if (prj->flag != AIT) {
4960     if ((status = aitset(prj))) return status;
4961   }
4962 
4963   if (ntheta > 0) {
4964     mphi   = nphi;
4965     mtheta = ntheta;
4966   } else {
4967     mphi   = 1;
4968     mtheta = 1;
4969     ntheta = nphi;
4970   }
4971 
4972 
4973   // Do phi dependence.
4974   phip = phi;
4975   rowoff = 0;
4976   rowlen = nphi*sxy;
4977   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
4978     w = (*phip)/2.0;
4979     sincosd(w, &sinphi, &cosphi);
4980 
4981     xp = x + rowoff;
4982     yp = y + rowoff;
4983     for (itheta = 0; itheta < mtheta; itheta++) {
4984       *xp = sinphi;
4985       *yp = cosphi;
4986       xp += rowlen;
4987       yp += rowlen;
4988     }
4989   }
4990 
4991 
4992   // Do theta dependence.
4993   thetap = theta;
4994   xp = x;
4995   yp = y;
4996   statp = stat;
4997   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
4998     sincosd(*thetap, &sinthe, &costhe);
4999 
5000     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
5001       w = sqrt(prj->w[0]/(1.0 + costhe*(*yp)));
5002       *xp = 2.0*w*costhe*(*xp) - prj->x0;
5003       *yp = w*sinthe - prj->y0;
5004       *(statp++) = 0;
5005     }
5006   }
5007 
5008   return 0;
5009 }
5010 
5011 /*============================================================================
5012 *   COP: conic perspective projection.
5013 *
5014 *   Given:
5015 *      prj->pv[1]   sigma = (theta2+theta1)/2
5016 *      prj->pv[2]   delta = (theta2-theta1)/2, where theta1 and theta2 are the
5017 *                   latitudes of the standard parallels, in degrees.
5018 *
5019 *   Given and/or returned:
5020 *      prj->r0      Reset to 180/pi if 0.
5021 *      prj->phi0    Reset to sigma if undefined.
5022 *      prj->theta0  Reset to sigma if undefined.
5023 *
5024 *   Returned:
5025 *      prj->flag     COP
5026 *      prj->code    "COP"
5027 *      prj->x0      Fiducial offset in x.
5028 *      prj->y0      Fiducial offset in y.
5029 *      prj->w[0]    C  = sin(sigma)
5030 *      prj->w[1]    1/C
5031 *      prj->w[2]    Y0 = r0*cos(delta)*cot(sigma)
5032 *      prj->w[3]    r0*cos(delta)
5033 *      prj->w[4]    1/(r0*cos(delta)
5034 *      prj->w[5]    cot(sigma)
5035 *      prj->prjx2s  Pointer to copx2s().
5036 *      prj->prjs2x  Pointer to cops2x().
5037 *===========================================================================*/
5038 
copset(struct prjprm * prj)5039 int copset(struct prjprm *prj)
5040 
5041 {
5042   if (prj == 0x0) return PRJERR_NULL_POINTER;
5043 
5044   prj->flag = COP;
5045   strcpy(prj->code, "COP");
5046   strcpy(prj->name, "conic perspective");
5047 
5048   if (undefined(prj->pv[1])) {
5049     return PRJERR_BAD_PARAM_SET("copset");
5050   }
5051   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
5052   if (prj->r0 == 0.0) prj->r0 = R2D;
5053 
5054   prj->category  = CONIC;
5055   prj->pvrange   = 102;
5056   prj->simplezen = 0;
5057   prj->equiareal = 0;
5058   prj->conformal = 0;
5059   prj->global    = 0;
5060   prj->divergent = 1;
5061 
5062   prj->w[0] = sind(prj->pv[1]);
5063   if (prj->w[0] == 0.0) {
5064     return PRJERR_BAD_PARAM_SET("copset");
5065   }
5066 
5067   prj->w[1] = 1.0/prj->w[0];
5068 
5069   prj->w[3] = prj->r0*cosd(prj->pv[2]);
5070   if (prj->w[3] == 0.0) {
5071     return PRJERR_BAD_PARAM_SET("copset");
5072   }
5073 
5074   prj->w[4] = 1.0/prj->w[3];
5075   prj->w[5] = 1.0/tand(prj->pv[1]);
5076 
5077   prj->w[2] = prj->w[3]*prj->w[5];
5078 
5079   prj->prjx2s = copx2s;
5080   prj->prjs2x = cops2x;
5081 
5082   return prjoff(prj, 0.0, prj->pv[1]);
5083 }
5084 
5085 //----------------------------------------------------------------------------
5086 
copx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])5087 int copx2s(
5088   struct prjprm *prj,
5089   int nx,
5090   int ny,
5091   int sxy,
5092   int spt,
5093   const double x[],
5094   const double y[],
5095   double phi[],
5096   double theta[],
5097   int stat[])
5098 
5099 {
5100   int mx, my, rowlen, rowoff, status;
5101   double alpha, dy, dy2, r, xj;
5102   register int ix, iy, *statp;
5103   register const double *xp, *yp;
5104   register double *phip, *thetap;
5105 
5106   // Initialize.
5107   if (prj == 0x0) return PRJERR_NULL_POINTER;
5108   if (prj->flag != COP) {
5109     if ((status = copset(prj))) return status;
5110   }
5111 
5112   if (ny > 0) {
5113     mx = nx;
5114     my = ny;
5115   } else {
5116     mx = 1;
5117     my = 1;
5118     ny = nx;
5119   }
5120 
5121   status = 0;
5122 
5123 
5124   // Do x dependence.
5125   xp = x;
5126   rowoff = 0;
5127   rowlen = nx*spt;
5128   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
5129     xj = *xp + prj->x0;
5130 
5131     phip = phi + rowoff;
5132     for (iy = 0; iy < my; iy++) {
5133       *phip = xj;
5134       phip += rowlen;
5135     }
5136   }
5137 
5138 
5139   // Do y dependence.
5140   yp = y;
5141   phip   = phi;
5142   thetap = theta;
5143   statp  = stat;
5144   for (iy = 0; iy < ny; iy++, yp += sxy) {
5145     dy  = prj->w[2] - (*yp + prj->y0);
5146     dy2 = dy*dy;
5147 
5148     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
5149       xj = *phip;
5150 
5151       r = sqrt(xj*xj + dy2);
5152       if (prj->pv[1] < 0.0) r = -r;
5153 
5154       if (r == 0.0) {
5155         alpha = 0.0;
5156       } else {
5157         alpha = atan2d(xj/r, dy/r);
5158       }
5159 
5160       *phip = alpha*prj->w[1];
5161       *thetap = prj->pv[1] + atand(prj->w[5] - r*prj->w[4]);
5162       *(statp++) = 0;
5163     }
5164   }
5165 
5166 
5167   // Do bounds checking on the native coordinates.
5168   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
5169     if (!status) status = PRJERR_BAD_PIX_SET("copx2s");
5170   }
5171 
5172   return status;
5173 }
5174 
5175 //----------------------------------------------------------------------------
5176 
cops2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])5177 int cops2x(
5178   struct prjprm *prj,
5179   int nphi,
5180   int ntheta,
5181   int spt,
5182   int sxy,
5183   const double phi[],
5184   const double theta[],
5185   double x[],
5186   double y[],
5187   int stat[])
5188 
5189 {
5190   int mphi, mtheta, rowlen, rowoff, status;
5191   double alpha, cosalpha, r, s, t, sinalpha, y0;
5192   register int iphi, itheta, istat, *statp;
5193   register const double *phip, *thetap;
5194   register double *xp, *yp;
5195 
5196   // Initialize.
5197   if (prj == 0x0) return PRJERR_NULL_POINTER;
5198   if (prj->flag != COP) {
5199     if ((status = copset(prj))) return status;
5200   }
5201 
5202   if (ntheta > 0) {
5203     mphi   = nphi;
5204     mtheta = ntheta;
5205   } else {
5206     mphi   = 1;
5207     mtheta = 1;
5208     ntheta = nphi;
5209   }
5210 
5211   status = 0;
5212 
5213 
5214   // Do phi dependence.
5215   phip = phi;
5216   rowoff = 0;
5217   rowlen = nphi*sxy;
5218   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
5219     alpha = prj->w[0]*(*phip);
5220     sincosd(alpha, &sinalpha, &cosalpha);
5221 
5222     xp = x + rowoff;
5223     yp = y + rowoff;
5224     for (itheta = 0; itheta < mtheta; itheta++) {
5225       *xp = sinalpha;
5226       *yp = cosalpha;
5227       xp += rowlen;
5228       yp += rowlen;
5229     }
5230   }
5231 
5232 
5233   // Do theta dependence.
5234   thetap = theta;
5235   xp = x;
5236   yp = y;
5237   statp = stat;
5238   y0 = prj->y0 - prj->w[2];
5239   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
5240     t = *thetap - prj->pv[1];
5241     s = cosd(t);
5242 
5243     istat = 0;
5244     if (s == 0.0) {
5245       // Latitude of divergence.
5246       r = 0.0;
5247       istat = 1;
5248       if (!status) status = PRJERR_BAD_WORLD_SET("cops2x");
5249 
5250     } else if (fabs(*thetap) == 90.0) {
5251       // Return an exact value at the poles.
5252       r = 0.0;
5253 
5254       // Bounds checking.
5255       if (prj->bounds&1) {
5256         if ((*thetap < 0.0) != (prj->pv[1] < 0.0)) {
5257           istat = 1;
5258           if (!status) status = PRJERR_BAD_WORLD_SET("cops2x");
5259         }
5260       }
5261 
5262     } else {
5263       r = prj->w[2] - prj->w[3]*sind(t)/s;
5264 
5265       // Bounds checking.
5266       if (prj->bounds&1) {
5267         if (r*prj->w[0] < 0.0) {
5268           istat = 1;
5269           if (!status) status = PRJERR_BAD_WORLD_SET("cops2x");
5270         }
5271       }
5272     }
5273 
5274     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
5275       *xp =  r*(*xp) - prj->x0;
5276       *yp = -r*(*yp) - y0;
5277       *(statp++) = istat;
5278     }
5279   }
5280 
5281   return status;
5282 }
5283 
5284 /*============================================================================
5285 *   COE: conic equal area projection.
5286 *
5287 *   Given:
5288 *      prj->pv[1]   sigma = (theta2+theta1)/2
5289 *      prj->pv[2]   delta = (theta2-theta1)/2, where theta1 and theta2 are the
5290 *                   latitudes of the standard parallels, in degrees.
5291 *
5292 *   Given and/or returned:
5293 *      prj->r0      Reset to 180/pi if 0.
5294 *      prj->phi0    Reset to sigma if undefined.
5295 *      prj->theta0  Reset to sigma if undefined.
5296 *
5297 *   Returned:
5298 *      prj->flag     COE
5299 *      prj->code    "COE"
5300 *      prj->x0      Fiducial offset in x.
5301 *      prj->y0      Fiducial offset in y.
5302 *      prj->w[0]    C = (sin(theta1) + sin(theta2))/2
5303 *      prj->w[1]    1/C
5304 *      prj->w[2]    Y0 = chi*sqrt(psi - 2C*sind(sigma))
5305 *      prj->w[3]    chi = r0/C
5306 *      prj->w[4]    psi = 1 + sin(theta1)*sin(theta2)
5307 *      prj->w[5]    2C
5308 *      prj->w[6]    (1 + sin(theta1)*sin(theta2))*(r0/C)**2
5309 *      prj->w[7]    C/(2*r0**2)
5310 *      prj->w[8]    chi*sqrt(psi + 2C)
5311 *      prj->prjx2s  Pointer to coex2s().
5312 *      prj->prjs2x  Pointer to coes2x().
5313 *===========================================================================*/
5314 
coeset(struct prjprm * prj)5315 int coeset(struct prjprm *prj)
5316 
5317 {
5318   double theta1, theta2;
5319 
5320   if (prj == 0x0) return PRJERR_NULL_POINTER;
5321 
5322   prj->flag = COE;
5323   strcpy(prj->code, "COE");
5324   strcpy(prj->name, "conic equal area");
5325 
5326   if (undefined(prj->pv[1])) {
5327     return PRJERR_BAD_PARAM_SET("coeset");
5328   }
5329   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
5330   if (prj->r0 == 0.0) prj->r0 = R2D;
5331 
5332   prj->category  = CONIC;
5333   prj->pvrange   = 102;
5334   prj->simplezen = 0;
5335   prj->equiareal = 1;
5336   prj->conformal = 0;
5337   prj->global    = 1;
5338   prj->divergent = 0;
5339 
5340   theta1 = prj->pv[1] - prj->pv[2];
5341   theta2 = prj->pv[1] + prj->pv[2];
5342 
5343   prj->w[0] = (sind(theta1) + sind(theta2))/2.0;
5344   if (prj->w[0] == 0.0) {
5345     return PRJERR_BAD_PARAM_SET("coeset");
5346   }
5347 
5348   prj->w[1] = 1.0/prj->w[0];
5349 
5350   prj->w[3] = prj->r0/prj->w[0];
5351   prj->w[4] = 1.0 + sind(theta1)*sind(theta2);
5352   prj->w[5] = 2.0*prj->w[0];
5353   prj->w[6] = prj->w[3]*prj->w[3]*prj->w[4];
5354   prj->w[7] = 1.0/(2.0*prj->r0*prj->w[3]);
5355   prj->w[8] = prj->w[3]*sqrt(prj->w[4] + prj->w[5]);
5356 
5357   prj->w[2] = prj->w[3]*sqrt(prj->w[4] - prj->w[5]*sind(prj->pv[1]));
5358 
5359   prj->prjx2s = coex2s;
5360   prj->prjs2x = coes2x;
5361 
5362   return prjoff(prj, 0.0, prj->pv[1]);
5363 }
5364 
5365 //----------------------------------------------------------------------------
5366 
coex2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])5367 int coex2s(
5368   struct prjprm *prj,
5369   int nx,
5370   int ny,
5371   int sxy,
5372   int spt,
5373   const double x[],
5374   const double y[],
5375   double phi[],
5376   double theta[],
5377   int stat[])
5378 
5379 {
5380   int mx, my, rowlen, rowoff, status;
5381   double alpha, dy, dy2, r, t, w, xj;
5382   const double tol = 1.0e-12;
5383   register int ix, iy, istat, *statp;
5384   register const double *xp, *yp;
5385   register double *phip, *thetap;
5386 
5387   // Initialize.
5388   if (prj == 0x0) return PRJERR_NULL_POINTER;
5389   if (prj->flag != COE) {
5390     if ((status = coeset(prj))) return status;
5391   }
5392 
5393   if (ny > 0) {
5394     mx = nx;
5395     my = ny;
5396   } else {
5397     mx = 1;
5398     my = 1;
5399     ny = nx;
5400   }
5401 
5402   status = 0;
5403 
5404 
5405   // Do x dependence.
5406   xp = x;
5407   rowoff = 0;
5408   rowlen = nx*spt;
5409   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
5410     xj = *xp + prj->x0;
5411 
5412     phip = phi + rowoff;
5413     for (iy = 0; iy < my; iy++) {
5414       *phip = xj;
5415       phip += rowlen;
5416     }
5417   }
5418 
5419 
5420   // Do y dependence.
5421   yp = y;
5422   phip   = phi;
5423   thetap = theta;
5424   statp  = stat;
5425   for (iy = 0; iy < ny; iy++, yp += sxy) {
5426     dy  = prj->w[2] - (*yp + prj->y0);
5427     dy2 = dy*dy;
5428 
5429     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
5430       xj = *phip;
5431 
5432       r = sqrt(xj*xj + dy2);
5433       if (prj->pv[1] < 0.0) r = -r;
5434 
5435       if (r == 0.0) {
5436         alpha = 0.0;
5437       } else {
5438         alpha = atan2d(xj/r, dy/r);
5439       }
5440 
5441       istat = 0;
5442       if (fabs(r - prj->w[8]) < tol) {
5443         t = -90.0;
5444       } else {
5445         w = (prj->w[6] - r*r)*prj->w[7];
5446         if (fabs(w) > 1.0) {
5447           if (fabs(w-1.0) < tol) {
5448             t = 90.0;
5449           } else if (fabs(w+1.0) < tol) {
5450             t = -90.0;
5451           } else {
5452             t = 0.0;
5453             istat = 1;
5454             if (!status) status = PRJERR_BAD_PIX_SET("coex2s");
5455           }
5456         } else {
5457           t = asind(w);
5458         }
5459       }
5460 
5461       *phip = alpha*prj->w[1];
5462       *thetap = t;
5463       *(statp++) = istat;
5464     }
5465   }
5466 
5467 
5468   // Do bounds checking on the native coordinates.
5469   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
5470     if (!status) status = PRJERR_BAD_PIX_SET("coex2s");
5471   }
5472 
5473   return status;
5474 }
5475 
5476 //----------------------------------------------------------------------------
5477 
coes2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])5478 int coes2x(
5479   struct prjprm *prj,
5480   int nphi,
5481   int ntheta,
5482   int spt,
5483   int sxy,
5484   const double phi[],
5485   const double theta[],
5486   double x[],
5487   double y[],
5488   int stat[])
5489 
5490 {
5491   int mphi, mtheta, rowlen, rowoff, status;
5492   double alpha, cosalpha, r, sinalpha, y0;
5493   register int iphi, itheta, *statp;
5494   register const double *phip, *thetap;
5495   register double *xp, *yp;
5496 
5497   // Initialize.
5498   if (prj == 0x0) return PRJERR_NULL_POINTER;
5499   if (prj->flag != COE) {
5500     if ((status = coeset(prj))) return status;
5501   }
5502 
5503   if (ntheta > 0) {
5504     mphi   = nphi;
5505     mtheta = ntheta;
5506   } else {
5507     mphi   = 1;
5508     mtheta = 1;
5509     ntheta = nphi;
5510   }
5511 
5512 
5513   // Do phi dependence.
5514   phip = phi;
5515   rowoff = 0;
5516   rowlen = nphi*sxy;
5517   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
5518     alpha = prj->w[0]*(*phip);
5519     sincosd(alpha, &sinalpha, &cosalpha);
5520 
5521     xp = x + rowoff;
5522     yp = y + rowoff;
5523     for (itheta = 0; itheta < mtheta; itheta++) {
5524       *xp = sinalpha;
5525       *yp = cosalpha;
5526       xp += rowlen;
5527       yp += rowlen;
5528     }
5529   }
5530 
5531 
5532   // Do theta dependence.
5533   thetap = theta;
5534   xp = x;
5535   yp = y;
5536   statp = stat;
5537   y0 = prj->y0 - prj->w[2];
5538   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
5539     if (*thetap == -90.0) {
5540       r = prj->w[8];
5541     } else {
5542       r = prj->w[3]*sqrt(prj->w[4] - prj->w[5]*sind(*thetap));
5543     }
5544 
5545     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
5546       *xp =  r*(*xp) - prj->x0;
5547       *yp = -r*(*yp) - y0;
5548       *(statp++) = 0;
5549     }
5550   }
5551 
5552   return 0;
5553 }
5554 
5555 /*============================================================================
5556 *   COD: conic equidistant projection.
5557 *
5558 *   Given:
5559 *      prj->pv[1]   sigma = (theta2+theta1)/2
5560 *      prj->pv[2]   delta = (theta2-theta1)/2, where theta1 and theta2 are the
5561 *                   latitudes of the standard parallels, in degrees.
5562 *
5563 *   Given and/or returned:
5564 *      prj->r0      Reset to 180/pi if 0.
5565 *      prj->phi0    Reset to sigma if undefined.
5566 *      prj->theta0  Reset to sigma if undefined.
5567 *
5568 *   Returned:
5569 *      prj->flag     COD
5570 *      prj->code    "COD"
5571 *      prj->x0      Fiducial offset in x.
5572 *      prj->y0      Fiducial offset in y.
5573 *      prj->w[0]    C = r0*sin(sigma)*sin(delta)/delta
5574 *      prj->w[1]    1/C
5575 *      prj->w[2]    Y0 = delta*cot(delta)*cot(sigma)
5576 *      prj->w[3]    Y0 + sigma
5577 *      prj->prjx2s  Pointer to codx2s().
5578 *      prj->prjs2x  Pointer to cods2x().
5579 *===========================================================================*/
5580 
codset(struct prjprm * prj)5581 int codset(struct prjprm *prj)
5582 
5583 {
5584   if (prj == 0x0) return PRJERR_NULL_POINTER;
5585 
5586   prj->flag = COD;
5587   strcpy(prj->code, "COD");
5588   strcpy(prj->name, "conic equidistant");
5589 
5590   if (undefined(prj->pv[1])) {
5591     return PRJERR_BAD_PARAM_SET("codset");
5592   }
5593   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
5594   if (prj->r0 == 0.0) prj->r0 = R2D;
5595 
5596   prj->category  = CONIC;
5597   prj->pvrange   = 102;
5598   prj->simplezen = 0;
5599   prj->equiareal = 0;
5600   prj->conformal = 0;
5601   prj->global    = 1;
5602   prj->divergent = 0;
5603 
5604   if (prj->pv[2] == 0.0) {
5605     prj->w[0] = prj->r0*sind(prj->pv[1])*D2R;
5606   } else {
5607     prj->w[0] = prj->r0*sind(prj->pv[1])*sind(prj->pv[2])/prj->pv[2];
5608   }
5609 
5610   if (prj->w[0] == 0.0) {
5611     return PRJERR_BAD_PARAM_SET("codset");
5612   }
5613 
5614   prj->w[1] = 1.0/prj->w[0];
5615   prj->w[2] = prj->r0*cosd(prj->pv[2])*cosd(prj->pv[1])/prj->w[0];
5616   prj->w[3] = prj->w[2] + prj->pv[1];
5617 
5618   prj->prjx2s = codx2s;
5619   prj->prjs2x = cods2x;
5620 
5621   return prjoff(prj, 0.0, prj->pv[1]);
5622 }
5623 
5624 //----------------------------------------------------------------------------
5625 
codx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])5626 int codx2s(
5627   struct prjprm *prj,
5628   int nx,
5629   int ny,
5630   int sxy,
5631   int spt,
5632   const double x[],
5633   const double y[],
5634   double phi[],
5635   double theta[],
5636   int stat[])
5637 
5638 {
5639   int mx, my, rowlen, rowoff, status;
5640   double alpha, dy, dy2, r, xj;
5641   register int ix, iy, *statp;
5642   register const double *xp, *yp;
5643   register double *phip, *thetap;
5644 
5645   // Initialize.
5646   if (prj == 0x0) return PRJERR_NULL_POINTER;
5647   if (prj->flag != COD) {
5648     if ((status = codset(prj))) return status;
5649   }
5650 
5651   if (ny > 0) {
5652     mx = nx;
5653     my = ny;
5654   } else {
5655     mx = 1;
5656     my = 1;
5657     ny = nx;
5658   }
5659 
5660   status = 0;
5661 
5662 
5663   // Do x dependence.
5664   xp = x;
5665   rowoff = 0;
5666   rowlen = nx*spt;
5667   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
5668     xj = *xp + prj->x0;
5669 
5670     phip = phi + rowoff;
5671     for (iy = 0; iy < my; iy++) {
5672       *phip = xj;
5673       phip += rowlen;
5674     }
5675   }
5676 
5677 
5678   // Do y dependence.
5679   yp = y;
5680   phip   = phi;
5681   thetap = theta;
5682   statp  = stat;
5683   for (iy = 0; iy < ny; iy++, yp += sxy) {
5684     dy  = prj->w[2] - (*yp + prj->y0);
5685     dy2 = dy*dy;
5686 
5687     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
5688       xj = *phip;
5689 
5690       r = sqrt(xj*xj + dy2);
5691       if (prj->pv[1] < 0.0) r = -r;
5692 
5693       if (r == 0.0) {
5694         alpha = 0.0;
5695       } else {
5696         alpha = atan2d(xj/r, dy/r);
5697       }
5698 
5699       *phip = alpha*prj->w[1];
5700       *thetap = prj->w[3] - r;
5701       *(statp++) = 0;
5702     }
5703   }
5704 
5705 
5706   // Do bounds checking on the native coordinates.
5707   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
5708     if (!status) status = PRJERR_BAD_PIX_SET("codx2s");
5709   }
5710 
5711   return status;
5712 }
5713 
5714 //----------------------------------------------------------------------------
5715 
cods2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])5716 int cods2x(
5717   struct prjprm *prj,
5718   int nphi,
5719   int ntheta,
5720   int spt,
5721   int sxy,
5722   const double phi[],
5723   const double theta[],
5724   double x[],
5725   double y[],
5726   int stat[])
5727 
5728 {
5729   int mphi, mtheta, rowlen, rowoff, status;
5730   double alpha, cosalpha, r, sinalpha, y0;
5731   register int iphi, itheta, *statp;
5732   register const double *phip, *thetap;
5733   register double *xp, *yp;
5734 
5735   // Initialize.
5736   if (prj == 0x0) return PRJERR_NULL_POINTER;
5737   if (prj->flag != COD) {
5738     if ((status = codset(prj))) return status;
5739   }
5740 
5741   if (ntheta > 0) {
5742     mphi   = nphi;
5743     mtheta = ntheta;
5744   } else {
5745     mphi   = 1;
5746     mtheta = 1;
5747     ntheta = nphi;
5748   }
5749 
5750 
5751   // Do phi dependence.
5752   phip = phi;
5753   rowoff = 0;
5754   rowlen = nphi*sxy;
5755   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
5756     alpha = prj->w[0]*(*phip);
5757     sincosd(alpha, &sinalpha, &cosalpha);
5758 
5759     xp = x + rowoff;
5760     yp = y + rowoff;
5761     for (itheta = 0; itheta < mtheta; itheta++) {
5762       *xp = sinalpha;
5763       *yp = cosalpha;
5764       xp += rowlen;
5765       yp += rowlen;
5766     }
5767   }
5768 
5769 
5770   // Do theta dependence.
5771   thetap = theta;
5772   xp = x;
5773   yp = y;
5774   statp = stat;
5775   y0 = prj->y0 - prj->w[2];
5776   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
5777     r = prj->w[3] - *thetap;
5778 
5779     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
5780       *xp =  r*(*xp) - prj->x0;
5781       *yp = -r*(*yp) - y0;
5782       *(statp++) = 0;
5783     }
5784   }
5785 
5786   return 0;
5787 }
5788 
5789 /*============================================================================
5790 *   COO: conic orthomorphic projection.
5791 *
5792 *   Given:
5793 *      prj->pv[1]   sigma = (theta2+theta1)/2
5794 *      prj->pv[2]   delta = (theta2-theta1)/2, where theta1 and theta2 are the
5795 *                   latitudes of the standard parallels, in degrees.
5796 *
5797 *   Given and/or returned:
5798 *      prj->r0      Reset to 180/pi if 0.
5799 *      prj->phi0    Reset to sigma if undefined.
5800 *      prj->theta0  Reset to sigma if undefined.
5801 *
5802 *   Returned:
5803 *      prj->flag     COO
5804 *      prj->code    "COO"
5805 *      prj->x0      Fiducial offset in x.
5806 *      prj->y0      Fiducial offset in y.
5807 *      prj->w[0]    C = ln(cos(theta2)/cos(theta1))/ln(tan(tau2)/tan(tau1))
5808 *                       where tau1 = (90 - theta1)/2
5809 *                             tau2 = (90 - theta2)/2
5810 *      prj->w[1]    1/C
5811 *      prj->w[2]    Y0 = psi*tan((90-sigma)/2)**C
5812 *      prj->w[3]    psi = (r0*cos(theta1)/C)/tan(tau1)**C
5813 *      prj->w[4]    1/psi
5814 *      prj->prjx2s  Pointer to coox2s().
5815 *      prj->prjs2x  Pointer to coos2x().
5816 *===========================================================================*/
5817 
cooset(struct prjprm * prj)5818 int cooset(struct prjprm *prj)
5819 
5820 {
5821   double cos1, cos2, tan1, tan2, theta1, theta2;
5822 
5823   if (prj == 0x0) return PRJERR_NULL_POINTER;
5824 
5825   prj->flag = COO;
5826   strcpy(prj->code, "COO");
5827   strcpy(prj->name, "conic orthomorphic");
5828 
5829   if (undefined(prj->pv[1])) {
5830     return PRJERR_BAD_PARAM_SET("cooset");
5831   }
5832   if (undefined(prj->pv[2])) prj->pv[2] = 0.0;
5833   if (prj->r0 == 0.0) prj->r0 = R2D;
5834 
5835   prj->category  = CONIC;
5836   prj->pvrange   = 102;
5837   prj->simplezen = 0;
5838   prj->equiareal = 0;
5839   prj->conformal = 1;
5840   prj->global    = 0;
5841   prj->divergent = 1;
5842 
5843   theta1 = prj->pv[1] - prj->pv[2];
5844   theta2 = prj->pv[1] + prj->pv[2];
5845 
5846   tan1 = tand((90.0 - theta1)/2.0);
5847   cos1 = cosd(theta1);
5848 
5849   if (theta1 == theta2) {
5850     prj->w[0] = sind(theta1);
5851   } else {
5852     tan2 = tand((90.0 - theta2)/2.0);
5853     cos2 = cosd(theta2);
5854     prj->w[0] = log(cos2/cos1)/log(tan2/tan1);
5855   }
5856   if (prj->w[0] == 0.0) {
5857     return PRJERR_BAD_PARAM_SET("cooset");
5858   }
5859 
5860   prj->w[1] = 1.0/prj->w[0];
5861 
5862   prj->w[3] = prj->r0*(cos1/prj->w[0])/pow(tan1,prj->w[0]);
5863   if (prj->w[3] == 0.0) {
5864     return PRJERR_BAD_PARAM_SET("cooset");
5865   }
5866   prj->w[2] = prj->w[3]*pow(tand((90.0 - prj->pv[1])/2.0),prj->w[0]);
5867   prj->w[4] = 1.0/prj->w[3];
5868 
5869   prj->prjx2s = coox2s;
5870   prj->prjs2x = coos2x;
5871 
5872   return prjoff(prj, 0.0, prj->pv[1]);
5873 }
5874 
5875 //----------------------------------------------------------------------------
5876 
coox2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])5877 int coox2s(
5878   struct prjprm *prj,
5879   int nx,
5880   int ny,
5881   int sxy,
5882   int spt,
5883   const double x[],
5884   const double y[],
5885   double phi[],
5886   double theta[],
5887   int stat[])
5888 
5889 {
5890   int mx, my, rowlen, rowoff, status;
5891   double alpha, dy, dy2, r, t, xj;
5892   register int ix, iy, istat, *statp;
5893   register const double *xp, *yp;
5894   register double *phip, *thetap;
5895 
5896   // Initialize.
5897   if (prj == 0x0) return PRJERR_NULL_POINTER;
5898   if (prj->flag != COO) {
5899     if ((status = cooset(prj))) return status;
5900   }
5901 
5902   if (ny > 0) {
5903     mx = nx;
5904     my = ny;
5905   } else {
5906     mx = 1;
5907     my = 1;
5908     ny = nx;
5909   }
5910 
5911   status = 0;
5912 
5913 
5914   // Do x dependence.
5915   xp = x;
5916   rowoff = 0;
5917   rowlen = nx*spt;
5918   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
5919     xj = *xp + prj->x0;
5920 
5921     phip = phi + rowoff;
5922     for (iy = 0; iy < my; iy++) {
5923       *phip = xj;
5924       phip += rowlen;
5925     }
5926   }
5927 
5928 
5929   // Do y dependence.
5930   yp = y;
5931   phip   = phi;
5932   thetap = theta;
5933   statp  = stat;
5934   for (iy = 0; iy < ny; iy++, yp += sxy) {
5935     dy  = prj->w[2] - (*yp + prj->y0);
5936     dy2 = dy*dy;
5937 
5938     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
5939       xj = *phip;
5940 
5941       r = sqrt(xj*xj + dy2);
5942       if (prj->pv[1] < 0.0) r = -r;
5943 
5944       if (r == 0.0) {
5945         alpha = 0.0;
5946       } else {
5947         alpha = atan2d(xj/r, dy/r);
5948       }
5949 
5950       istat = 0;
5951       if (r == 0.0) {
5952         if (prj->w[0] < 0.0) {
5953           t = -90.0;
5954         } else {
5955           t = 0.0;
5956           istat = 1;
5957           if (!status) status = PRJERR_BAD_PIX_SET("coox2s");
5958         }
5959       } else {
5960         t = 90.0 - 2.0*atand(pow(r*prj->w[4],prj->w[1]));
5961       }
5962 
5963       *phip = alpha*prj->w[1];
5964       *thetap = t;
5965       *(statp++) = istat;
5966     }
5967   }
5968 
5969 
5970   // Do bounds checking on the native coordinates.
5971   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
5972     if (!status) status = PRJERR_BAD_PIX_SET("coox2s");
5973   }
5974 
5975   return status;
5976 }
5977 
5978 //----------------------------------------------------------------------------
5979 
coos2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])5980 int coos2x(
5981   struct prjprm *prj,
5982   int nphi,
5983   int ntheta,
5984   int spt,
5985   int sxy,
5986   const double phi[],
5987   const double theta[],
5988   double x[],
5989   double y[],
5990   int stat[])
5991 
5992 {
5993   int mphi, mtheta, rowlen, rowoff, status;
5994   double alpha, cosalpha, r, sinalpha, y0;
5995   register int iphi, itheta, istat, *statp;
5996   register const double *phip, *thetap;
5997   register double *xp, *yp;
5998 
5999   // Initialize.
6000   if (prj == 0x0) return PRJERR_NULL_POINTER;
6001   if (prj->flag != COO) {
6002     if ((status = cooset(prj))) return status;
6003   }
6004 
6005   if (ntheta > 0) {
6006     mphi   = nphi;
6007     mtheta = ntheta;
6008   } else {
6009     mphi   = 1;
6010     mtheta = 1;
6011     ntheta = nphi;
6012   }
6013 
6014   status = 0;
6015 
6016 
6017   // Do phi dependence.
6018   phip = phi;
6019   rowoff = 0;
6020   rowlen = nphi*sxy;
6021   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
6022     alpha = prj->w[0]*(*phip);
6023     sincosd(alpha, &sinalpha, &cosalpha);
6024 
6025     xp = x + rowoff;
6026     yp = y + rowoff;
6027     for (itheta = 0; itheta < mtheta; itheta++) {
6028       *xp = sinalpha;
6029       *yp = cosalpha;
6030       xp += rowlen;
6031       yp += rowlen;
6032     }
6033   }
6034 
6035 
6036   // Do theta dependence.
6037   thetap = theta;
6038   xp = x;
6039   yp = y;
6040   statp = stat;
6041   y0 = prj->y0 - prj->w[2];
6042   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
6043     istat = 0;
6044 
6045     if (*thetap == -90.0) {
6046       r = 0.0;
6047       if (prj->w[0] >= 0.0) {
6048         istat = 1;
6049         if (!status) status = PRJERR_BAD_WORLD_SET("coos2x");
6050       }
6051     } else {
6052       r = prj->w[3]*pow(tand((90.0 - *thetap)/2.0),prj->w[0]);
6053     }
6054 
6055     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6056       *xp =  r*(*xp) - prj->x0;
6057       *yp = -r*(*yp) - y0;
6058       *(statp++) = istat;
6059     }
6060   }
6061 
6062   return status;
6063 }
6064 
6065 /*============================================================================
6066 *   BON: Bonne's projection.
6067 *
6068 *   Given:
6069 *      prj->pv[1]   Bonne conformal latitude, theta1, in degrees.
6070 *
6071 *   Given and/or returned:
6072 *      prj->r0      Reset to 180/pi if 0.
6073 *      prj->phi0    Reset to 0.0 if undefined.
6074 *      prj->theta0  Reset to 0.0 if undefined.
6075 *
6076 *   Returned:
6077 *      prj->flag     BON
6078 *      prj->code    "BON"
6079 *      prj->x0      Fiducial offset in x.
6080 *      prj->y0      Fiducial offset in y.
6081 *      prj->w[1]    r0*pi/180
6082 *      prj->w[2]    Y0 = r0*(cot(theta1) + theta1*pi/180)
6083 *      prj->prjx2s  Pointer to bonx2s().
6084 *      prj->prjs2x  Pointer to bons2x().
6085 *===========================================================================*/
6086 
bonset(struct prjprm * prj)6087 int bonset(struct prjprm *prj)
6088 
6089 {
6090   if (prj == 0x0) return PRJERR_NULL_POINTER;
6091 
6092   prj->flag = BON;
6093   strcpy(prj->code, "BON");
6094   strcpy(prj->name, "Bonne's");
6095 
6096   if (undefined(prj->pv[1])) {
6097     return PRJERR_BAD_PARAM_SET("bonset");
6098   }
6099 
6100   if (prj->pv[1] == 0.0) {
6101     // Sanson-Flamsteed.
6102     return sflset(prj);
6103   }
6104 
6105   prj->category  = POLYCONIC;
6106   prj->pvrange   = 101;
6107   prj->simplezen = 0;
6108   prj->equiareal = 1;
6109   prj->conformal = 0;
6110   prj->global    = 1;
6111   prj->divergent = 0;
6112 
6113   if (prj->r0 == 0.0) {
6114     prj->r0 = R2D;
6115     prj->w[1] = 1.0;
6116     prj->w[2] = prj->r0*cosd(prj->pv[1])/sind(prj->pv[1]) + prj->pv[1];
6117   } else {
6118     prj->w[1] = prj->r0*D2R;
6119     prj->w[2] = prj->r0*(cosd(prj->pv[1])/sind(prj->pv[1]) + prj->pv[1]*D2R);
6120   }
6121 
6122   prj->prjx2s = bonx2s;
6123   prj->prjs2x = bons2x;
6124 
6125   return prjoff(prj, 0.0, 0.0);
6126 }
6127 
6128 //----------------------------------------------------------------------------
6129 
bonx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])6130 int bonx2s(
6131   struct prjprm *prj,
6132   int nx,
6133   int ny,
6134   int sxy,
6135   int spt,
6136   const double x[],
6137   const double y[],
6138   double phi[],
6139   double theta[],
6140   int stat[])
6141 
6142 {
6143   int mx, my, rowlen, rowoff, status;
6144   double alpha, dy, dy2, costhe, r, s, t, xj;
6145   register int ix, iy, *statp;
6146   register const double *xp, *yp;
6147   register double *phip, *thetap;
6148 
6149 
6150   // Initialize.
6151   if (prj == 0x0) return PRJERR_NULL_POINTER;
6152   if (prj->pv[1] == 0.0) {
6153     // Sanson-Flamsteed.
6154     return sflx2s(prj, nx, ny, sxy, spt, x, y, phi, theta, stat);
6155   }
6156 
6157   if (prj->flag != BON) {
6158     if ((status = bonset(prj))) return status;
6159   }
6160 
6161   if (ny > 0) {
6162     mx = nx;
6163     my = ny;
6164   } else {
6165     mx = 1;
6166     my = 1;
6167     ny = nx;
6168   }
6169 
6170   status = 0;
6171 
6172 
6173   // Do x dependence.
6174   xp = x;
6175   rowoff = 0;
6176   rowlen = nx*spt;
6177   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
6178     xj = *xp + prj->x0;
6179 
6180     phip = phi + rowoff;
6181     for (iy = 0; iy < my; iy++) {
6182       *phip = xj;
6183       phip += rowlen;
6184     }
6185   }
6186 
6187 
6188   // Do y dependence.
6189   yp = y;
6190   phip   = phi;
6191   thetap = theta;
6192   statp  = stat;
6193   for (iy = 0; iy < ny; iy++, yp += sxy) {
6194     dy  = prj->w[2] - (*yp + prj->y0);
6195     dy2 = dy*dy;
6196 
6197     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
6198       xj = *phip;
6199 
6200       r = sqrt(xj*xj + dy2);
6201       if (prj->pv[1] < 0.0) r = -r;
6202 
6203       if (r == 0.0) {
6204         alpha = 0.0;
6205       } else {
6206         alpha = atan2d(xj/r, dy/r);
6207       }
6208 
6209       t = (prj->w[2] - r)/prj->w[1];
6210       costhe = cosd(t);
6211       if (costhe == 0.0) {
6212         s = 0.0;
6213       } else {
6214         s = alpha*(r/prj->r0)/costhe;
6215       }
6216 
6217       *phip = s;
6218       *thetap = t;
6219       *(statp++) = 0;
6220     }
6221   }
6222 
6223 
6224   // Do bounds checking on the native coordinates.
6225   if (prj->bounds&4 && prjbchk(1.0e-11, nx, my, spt, phi, theta, stat)) {
6226     if (!status) status = PRJERR_BAD_PIX_SET("bonx2s");
6227   }
6228 
6229   return status;
6230 }
6231 
6232 //----------------------------------------------------------------------------
6233 
bons2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])6234 int bons2x(
6235   struct prjprm *prj,
6236   int nphi,
6237   int ntheta,
6238   int spt,
6239   int sxy,
6240   const double phi[],
6241   const double theta[],
6242   double x[],
6243   double y[],
6244   int stat[])
6245 
6246 {
6247   int mphi, mtheta, rowlen, rowoff, status;
6248   double alpha, cosalpha, r, s, sinalpha, y0;
6249   register int iphi, itheta, *statp;
6250   register const double *phip, *thetap;
6251   register double *xp, *yp;
6252 
6253   // Initialize.
6254   if (prj == 0x0) return PRJERR_NULL_POINTER;
6255   if (prj->pv[1] == 0.0) {
6256     // Sanson-Flamsteed.
6257     return sfls2x(prj, nphi, ntheta, spt, sxy, phi, theta, x, y, stat);
6258   }
6259 
6260   if (prj->flag != BON) {
6261     if ((status = bonset(prj))) return status;
6262   }
6263 
6264   if (ntheta > 0) {
6265     mphi   = nphi;
6266     mtheta = ntheta;
6267   } else {
6268     mphi   = 1;
6269     mtheta = 1;
6270     ntheta = nphi;
6271   }
6272 
6273   y0 = prj->y0 - prj->w[2];
6274 
6275 
6276   // Do phi dependence.
6277   phip = phi;
6278   rowoff = 0;
6279   rowlen = nphi*sxy;
6280   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
6281     s = prj->r0*(*phip);
6282 
6283     xp = x + rowoff;
6284     for (itheta = 0; itheta < mtheta; itheta++) {
6285       *xp = s;
6286       xp += rowlen;
6287     }
6288   }
6289 
6290 
6291   // Do theta dependence.
6292   thetap = theta;
6293   xp = x;
6294   yp = y;
6295   statp = stat;
6296   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
6297     r = prj->w[2] - prj->w[1]*(*thetap);
6298     s = cosd(*thetap)/r;
6299 
6300     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6301       alpha = s*(*xp);
6302       sincosd(alpha, &sinalpha, &cosalpha);
6303       *xp =  r*sinalpha - prj->x0;
6304       *yp = -r*cosalpha - y0;
6305       *(statp++) = 0;
6306     }
6307   }
6308 
6309   return 0;
6310 }
6311 
6312 /*============================================================================
6313 *   PCO: polyconic projection.
6314 *
6315 *   Given and/or returned:
6316 *      prj->r0      Reset to 180/pi if 0.
6317 *      prj->phi0    Reset to 0.0 if undefined.
6318 *      prj->theta0  Reset to 0.0 if undefined.
6319 *
6320 *   Returned:
6321 *      prj->flag     PCO
6322 *      prj->code    "PCO"
6323 *      prj->x0      Fiducial offset in x.
6324 *      prj->y0      Fiducial offset in y.
6325 *      prj->w[0]    r0*(pi/180)
6326 *      prj->w[1]    (180/pi)/r0
6327 *      prj->w[2]    2*r0
6328 *      prj->w[3]    (pi/180)/(2*r0)
6329 *      prj->prjx2s  Pointer to pcox2s().
6330 *      prj->prjs2x  Pointer to pcos2x().
6331 *===========================================================================*/
6332 
pcoset(struct prjprm * prj)6333 int pcoset(struct prjprm *prj)
6334 
6335 {
6336   if (prj == 0x0) return PRJERR_NULL_POINTER;
6337 
6338   prj->flag = PCO;
6339   strcpy(prj->code, "PCO");
6340 
6341   strcpy(prj->name, "polyconic");
6342   prj->category  = POLYCONIC;
6343   prj->pvrange   = 0;
6344   prj->simplezen = 0;
6345   prj->equiareal = 0;
6346   prj->conformal = 0;
6347   prj->global    = 1;
6348   prj->divergent = 0;
6349 
6350   if (prj->r0 == 0.0) {
6351     prj->r0 = R2D;
6352     prj->w[0] = 1.0;
6353     prj->w[1] = 1.0;
6354     prj->w[2] = 360.0/PI;
6355   } else {
6356     prj->w[0] = prj->r0*D2R;
6357     prj->w[1] = 1.0/prj->w[0];
6358     prj->w[2] = 2.0*prj->r0;
6359   }
6360   prj->w[3] = D2R/prj->w[2];
6361 
6362   prj->prjx2s = pcox2s;
6363   prj->prjs2x = pcos2x;
6364 
6365   return prjoff(prj, 0.0, 0.0);
6366 }
6367 
6368 //----------------------------------------------------------------------------
6369 
pcox2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])6370 int pcox2s(
6371   struct prjprm *prj,
6372   int nx,
6373   int ny,
6374   int sxy,
6375   int spt,
6376   const double x[],
6377   const double y[],
6378   double phi[],
6379   double theta[],
6380   int stat[])
6381 
6382 {
6383   int mx, my, rowlen, rowoff, status;
6384   double f, fneg, fpos, lambda, tanthe, the, theneg, thepos, w, x1, xj, xx,
6385          yj, ymthe, y1;
6386   const double tol = 1.0e-12;
6387   register int ix, iy, k, *statp;
6388   register const double *xp, *yp;
6389   register double *phip, *thetap;
6390 
6391 
6392   // Initialize.
6393   if (prj == 0x0) return PRJERR_NULL_POINTER;
6394   if (prj->flag != PCO) {
6395     if ((status = pcoset(prj))) return status;
6396   }
6397 
6398   if (ny > 0) {
6399     mx = nx;
6400     my = ny;
6401   } else {
6402     mx = 1;
6403     my = 1;
6404     ny = nx;
6405   }
6406 
6407   status = 0;
6408 
6409 
6410   // Do x dependence.
6411   xp = x;
6412   rowoff = 0;
6413   rowlen = nx*spt;
6414   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
6415     xj = *xp + prj->x0;
6416 
6417     phip = phi + rowoff;
6418     for (iy = 0; iy < my; iy++) {
6419       *phip = xj;
6420       phip += rowlen;
6421     }
6422   }
6423 
6424 
6425   // Do y dependence.
6426   yp = y;
6427   phip   = phi;
6428   thetap = theta;
6429   statp  = stat;
6430   for (iy = 0; iy < ny; iy++, yp += sxy) {
6431     yj = *yp + prj->y0;
6432     w  = fabs(yj*prj->w[1]);
6433 
6434     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
6435       xj = *phip;
6436 
6437       if (w < tol) {
6438         *phip = xj*prj->w[1];
6439         *thetap = 0.0;
6440 
6441       } else if (fabs(w-90.0) < tol) {
6442         *phip = 0.0;
6443         *thetap = copysign(90.0, yj);
6444 
6445       } else {
6446         if (w < 1.0e-4) {
6447           // To avoid cot(theta) blowing up near theta == 0.
6448           the    = yj / (prj->w[0] + prj->w[3]*xj*xj);
6449           ymthe  = yj - prj->w[0]*the;
6450           tanthe = tand(the);
6451 
6452         } else {
6453           // Iterative solution using weighted division of the interval.
6454           thepos = yj / prj->w[0];
6455           theneg = 0.0;
6456 
6457           // Setting fneg = -fpos halves the interval in the first iter.
6458           xx = xj*xj;
6459           fpos  =  xx;
6460           fneg  = -xx;
6461 
6462           for (k = 0; k < 64; k++) {
6463             // Weighted division of the interval.
6464             lambda = fpos/(fpos-fneg);
6465             if (lambda < 0.1) {
6466               lambda = 0.1;
6467             } else if (lambda > 0.9) {
6468               lambda = 0.9;
6469             }
6470             the = thepos - lambda*(thepos-theneg);
6471 
6472             // Compute the residue.
6473             ymthe  = yj - prj->w[0]*the;
6474             tanthe = tand(the);
6475             f = xx + ymthe*(ymthe - prj->w[2]/tanthe);
6476 
6477             // Check for convergence.
6478             if (fabs(f) < tol) break;
6479             if (fabs(thepos-theneg) < tol) break;
6480 
6481             // Redefine the interval.
6482             if (f > 0.0) {
6483               thepos = the;
6484               fpos = f;
6485             } else {
6486               theneg = the;
6487               fneg = f;
6488             }
6489           }
6490         }
6491 
6492         x1 = prj->r0 - ymthe*tanthe;
6493         y1 = xj*tanthe;
6494         if (x1 == 0.0 && y1 == 0.0) {
6495           *phip = 0.0;
6496         } else {
6497           *phip = atan2d(y1, x1)/sind(the);
6498         }
6499 
6500         *thetap = the;
6501       }
6502 
6503       *(statp++) = 0;
6504     }
6505   }
6506 
6507 
6508   // Do bounds checking on the native coordinates.
6509   if (prj->bounds&4 && prjbchk(1.0e-12, nx, my, spt, phi, theta, stat)) {
6510     if (!status) status = PRJERR_BAD_PIX_SET("pcox2s");
6511   }
6512 
6513   return status;
6514 }
6515 
6516 //----------------------------------------------------------------------------
6517 
pcos2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])6518 int pcos2x(
6519   struct prjprm *prj,
6520   int nphi,
6521   int ntheta,
6522   int spt,
6523   int sxy,
6524   const double phi[],
6525   const double theta[],
6526   double x[],
6527   double y[],
6528   int stat[])
6529 
6530 {
6531   int mphi, mtheta, rowlen, rowoff, status;
6532   double cospsi, costhe, cotthe, sinpsi, sinthe, therad;
6533   register int iphi, itheta, *statp;
6534   register const double *phip, *thetap;
6535   register double *xp, *yp;
6536 
6537   // Initialize.
6538   if (prj == 0x0) return PRJERR_NULL_POINTER;
6539   if (prj->flag != PCO) {
6540     if ((status = pcoset(prj))) return status;
6541   }
6542 
6543   if (ntheta > 0) {
6544     mphi   = nphi;
6545     mtheta = ntheta;
6546   } else {
6547     mphi   = 1;
6548     mtheta = 1;
6549     ntheta = nphi;
6550   }
6551 
6552 
6553   // Do phi dependence.
6554   phip = phi;
6555   rowoff = 0;
6556   rowlen = nphi*sxy;
6557   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
6558     xp = x + rowoff;
6559     for (itheta = 0; itheta < mtheta; itheta++) {
6560       *xp = *phip;
6561       xp += rowlen;
6562     }
6563   }
6564 
6565 
6566   // Do theta dependence.
6567   thetap = theta;
6568   xp = x;
6569   yp = y;
6570   statp = stat;
6571   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
6572     if (*thetap == 0.0) {
6573       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6574         *xp =  prj->w[0]*(*xp) - prj->x0;
6575         *yp = -prj->y0;
6576         *(statp++) = 0;
6577       }
6578 
6579     } else if (fabs(*thetap) < 1.0e-4) {
6580       // To avoid cot(theta) blowing up near theta == 0.
6581       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6582         *xp = prj->w[0]*(*xp)*cosd(*thetap) - prj->x0;
6583         *yp = (prj->w[0] + prj->w[3]*(*xp)*(*xp))*(*thetap) - prj->y0;
6584         *(statp++) = 0;
6585       }
6586 
6587     } else {
6588       therad = (*thetap)*D2R;
6589       sincosd(*thetap, &sinthe, &costhe);
6590 
6591       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6592         sincosd((*xp)*sinthe, &sinpsi, &cospsi);
6593         cotthe = costhe/sinthe;
6594         *xp = prj->r0*cotthe*sinpsi - prj->x0;
6595         *yp = prj->r0*(cotthe*(1.0 - cospsi) + therad) - prj->y0;
6596         *(statp++) = 0;
6597       }
6598     }
6599   }
6600 
6601   return 0;
6602 }
6603 
6604 /*============================================================================
6605 *   TSC: tangential spherical cube projection.
6606 *
6607 *   Given and/or returned:
6608 *      prj->r0      Reset to 180/pi if 0.
6609 *      prj->phi0    Reset to 0.0 if undefined.
6610 *      prj->theta0  Reset to 0.0 if undefined.
6611 *
6612 *   Returned:
6613 *      prj->flag     TSC
6614 *      prj->code    "TSC"
6615 *      prj->x0      Fiducial offset in x.
6616 *      prj->y0      Fiducial offset in y.
6617 *      prj->w[0]    r0*(pi/4)
6618 *      prj->w[1]    (4/pi)/r0
6619 *      prj->prjx2s  Pointer to tscx2s().
6620 *      prj->prjs2x  Pointer to tscs2x().
6621 *===========================================================================*/
6622 
tscset(struct prjprm * prj)6623 int tscset(struct prjprm *prj)
6624 
6625 {
6626   if (prj == 0x0) return PRJERR_NULL_POINTER;
6627 
6628   prj->flag = TSC;
6629   strcpy(prj->code, "TSC");
6630 
6631   strcpy(prj->name, "tangential spherical cube");
6632   prj->category  = QUADCUBE;
6633   prj->pvrange   = 0;
6634   prj->simplezen = 0;
6635   prj->equiareal = 0;
6636   prj->conformal = 0;
6637   prj->global    = 1;
6638   prj->divergent = 0;
6639 
6640   if (prj->r0 == 0.0) {
6641     prj->r0 = R2D;
6642     prj->w[0] = 45.0;
6643     prj->w[1] = 1.0/45.0;
6644   } else {
6645     prj->w[0] = prj->r0*PI/4.0;
6646     prj->w[1] = 1.0/prj->w[0];
6647   }
6648 
6649   prj->prjx2s = tscx2s;
6650   prj->prjs2x = tscs2x;
6651 
6652   return prjoff(prj, 0.0, 0.0);
6653 }
6654 
6655 //----------------------------------------------------------------------------
6656 
tscx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])6657 int tscx2s(
6658   struct prjprm *prj,
6659   int nx,
6660   int ny,
6661   int sxy,
6662   int spt,
6663   const double x[],
6664   const double y[],
6665   double phi[],
6666   double theta[],
6667   int stat[])
6668 
6669 {
6670   int mx, my, rowlen, rowoff, status;
6671   double l, m, n, xf, yf;
6672   register int ix, iy, *statp;
6673   register const double *xp, *yp;
6674   register double *phip, *thetap;
6675 
6676 
6677   // Initialize.
6678   if (prj == 0x0) return PRJERR_NULL_POINTER;
6679   if (prj->flag != TSC) {
6680     if ((status = tscset(prj))) return status;
6681   }
6682 
6683   if (ny > 0) {
6684     mx = nx;
6685     my = ny;
6686   } else {
6687     mx = 1;
6688     my = 1;
6689     ny = nx;
6690   }
6691 
6692   status = 0;
6693 
6694 
6695   // Do x dependence.
6696   xp = x;
6697   rowoff = 0;
6698   rowlen = nx*spt;
6699   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
6700     xf = (*xp + prj->x0)*prj->w[1];
6701 
6702     phip = phi + rowoff;
6703     for (iy = 0; iy < my; iy++) {
6704       *phip = xf;
6705       phip += rowlen;
6706     }
6707   }
6708 
6709 
6710   // Do y dependence.
6711   yp = y;
6712   phip   = phi;
6713   thetap = theta;
6714   statp  = stat;
6715   for (iy = 0; iy < ny; iy++, yp += sxy) {
6716     yf = (*yp + prj->y0)*prj->w[1];
6717 
6718     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
6719       xf = *phip;
6720 
6721       // Bounds checking.
6722       if (fabs(xf) <= 1.0) {
6723         if (fabs(yf) > 3.0) {
6724           *phip = 0.0;
6725           *thetap = 0.0;
6726           *(statp++) = 1;
6727           if (!status) status = PRJERR_BAD_PIX_SET("tscx2s");
6728           continue;
6729         }
6730       } else {
6731         if (fabs(xf) > 7.0 || fabs(yf) > 1.0) {
6732           *phip = 0.0;
6733           *thetap = 0.0;
6734           *(statp++) = 1;
6735           if (!status) status = PRJERR_BAD_PIX_SET("tscx2s");
6736           continue;
6737         }
6738       }
6739 
6740       // Map negative faces to the other side.
6741       if (xf < -1.0) xf += 8.0;
6742 
6743       // Determine the face.
6744       if (xf > 5.0) {
6745         // face = 4
6746         xf = xf - 6.0;
6747         m  = -1.0/sqrt(1.0 + xf*xf + yf*yf);
6748         l  = -m*xf;
6749         n  = -m*yf;
6750       } else if (xf > 3.0) {
6751         // face = 3
6752         xf = xf - 4.0;
6753         l  = -1.0/sqrt(1.0 + xf*xf + yf*yf);
6754         m  =  l*xf;
6755         n  = -l*yf;
6756       } else if (xf > 1.0) {
6757         // face = 2
6758         xf = xf - 2.0;
6759         m  =  1.0/sqrt(1.0 + xf*xf + yf*yf);
6760         l  = -m*xf;
6761         n  =  m*yf;
6762       } else if (yf > 1.0) {
6763         // face = 0
6764         yf = yf - 2.0;
6765         n  = 1.0/sqrt(1.0 + xf*xf + yf*yf);
6766         l  = -n*yf;
6767         m  =  n*xf;
6768       } else if (yf < -1.0) {
6769         // face = 5
6770         yf = yf + 2.0;
6771         n  = -1.0/sqrt(1.0 + xf*xf + yf*yf);
6772         l  = -n*yf;
6773         m  = -n*xf;
6774       } else {
6775         // face = 1
6776         l  =  1.0/sqrt(1.0 + xf*xf + yf*yf);
6777         m  =  l*xf;
6778         n  =  l*yf;
6779       }
6780 
6781       if (l == 0.0 && m == 0.0) {
6782         *phip = 0.0;
6783       } else {
6784         *phip = atan2d(m, l);
6785       }
6786 
6787       *thetap = asind(n);
6788       *(statp++) = 0;
6789     }
6790   }
6791 
6792 
6793   // Do bounds checking on the native coordinates.
6794   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
6795     if (!status) status = PRJERR_BAD_PIX_SET("tscx2s");
6796   }
6797 
6798   return status;
6799 }
6800 
6801 //----------------------------------------------------------------------------
6802 
tscs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])6803 int tscs2x(
6804   struct prjprm *prj,
6805   int nphi,
6806   int ntheta,
6807   int spt,
6808   int sxy,
6809   const double phi[],
6810   const double theta[],
6811   double x[],
6812   double y[],
6813   int stat[])
6814 
6815 {
6816   int face, mphi, mtheta, rowlen, rowoff, status;
6817   double cosphi, costhe, l, m, n, sinphi, sinthe, x0, xf, y0, yf, zeta;
6818   const double tol = 1.0e-12;
6819   register int iphi, istat, itheta, *statp;
6820   register const double *phip, *thetap;
6821   register double *xp, *yp;
6822 
6823   // Initialize.
6824   if (prj == 0x0) return PRJERR_NULL_POINTER;
6825   if (prj->flag != TSC) {
6826     if ((status = tscset(prj))) return status;
6827   }
6828 
6829   if (ntheta > 0) {
6830     mphi   = nphi;
6831     mtheta = ntheta;
6832   } else {
6833     mphi   = 1;
6834     mtheta = 1;
6835     ntheta = nphi;
6836   }
6837 
6838   status = 0;
6839 
6840 
6841   // Do phi dependence.
6842   phip = phi;
6843   rowoff = 0;
6844   rowlen = nphi*sxy;
6845   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
6846     sincosd(*phip, &sinphi, &cosphi);
6847 
6848     xp = x + rowoff;
6849     yp = y + rowoff;
6850     for (itheta = 0; itheta < mtheta; itheta++) {
6851       *xp = cosphi;
6852       *yp = sinphi;
6853       xp += rowlen;
6854       yp += rowlen;
6855     }
6856   }
6857 
6858 
6859   // Do theta dependence.
6860   thetap = theta;
6861   xp = x;
6862   yp = y;
6863   statp = stat;
6864   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
6865     sincosd(*thetap, &sinthe, &costhe);
6866 
6867     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
6868       l = costhe*(*xp);
6869       m = costhe*(*yp);
6870       n = sinthe;
6871 
6872       face = 0;
6873       zeta = n;
6874       if (l > zeta) {
6875         face = 1;
6876         zeta = l;
6877       }
6878       if (m > zeta) {
6879         face = 2;
6880         zeta = m;
6881       }
6882       if (-l > zeta) {
6883         face = 3;
6884         zeta = -l;
6885       }
6886       if (-m > zeta) {
6887         face = 4;
6888         zeta = -m;
6889       }
6890       if (-n > zeta) {
6891         face = 5;
6892         zeta = -n;
6893       }
6894 
6895       switch (face) {
6896       case 1:
6897         xf =  m/zeta;
6898         yf =  n/zeta;
6899         x0 =  0.0;
6900         y0 =  0.0;
6901         break;
6902       case 2:
6903         xf = -l/zeta;
6904         yf =  n/zeta;
6905         x0 =  2.0;
6906         y0 =  0.0;
6907         break;
6908       case 3:
6909         xf = -m/zeta;
6910         yf =  n/zeta;
6911         x0 =  4.0;
6912         y0 =  0.0;
6913         break;
6914       case 4:
6915         xf =  l/zeta;
6916         yf =  n/zeta;
6917         x0 =  6.0;
6918         y0 =  0.0;
6919         break;
6920       case 5:
6921         xf =  m/zeta;
6922         yf =  l/zeta;
6923         x0 =  0.0;
6924         y0 = -2.0;
6925         break;
6926       default:
6927         // face == 0
6928         xf =  m/zeta;
6929         yf = -l/zeta;
6930         x0 =  0.0;
6931         y0 =  2.0;
6932         break;
6933       }
6934 
6935       istat = 0;
6936       if (fabs(xf) > 1.0) {
6937         if (fabs(xf) > 1.0+tol) {
6938           istat = 1;
6939           if (!status) status = PRJERR_BAD_WORLD_SET("tscs2x");
6940         }
6941         xf = copysign(1.0, xf);
6942       }
6943       if (fabs(yf) > 1.0) {
6944         if (fabs(yf) > 1.0+tol) {
6945           istat = 1;
6946           if (!status) status = PRJERR_BAD_WORLD_SET("tscs2x");
6947         }
6948         yf = copysign(1.0, yf);
6949       }
6950 
6951       *xp = prj->w[0]*(xf + x0) - prj->x0;
6952       *yp = prj->w[0]*(yf + y0) - prj->y0;
6953       *(statp++) = istat;
6954     }
6955   }
6956 
6957   return status;
6958 }
6959 
6960 /*============================================================================
6961 *   CSC: COBE quadrilateralized spherical cube projection.
6962 *
6963 *   Given and/or returned:
6964 *      prj->r0      Reset to 180/pi if 0.
6965 *      prj->phi0    Reset to 0.0 if undefined.
6966 *      prj->theta0  Reset to 0.0 if undefined.
6967 *
6968 *   Returned:
6969 *      prj->flag     CSC
6970 *      prj->code    "CSC"
6971 *      prj->x0      Fiducial offset in x.
6972 *      prj->y0      Fiducial offset in y.
6973 *      prj->w[0]    r0*(pi/4)
6974 *      prj->w[1]    (4/pi)/r0
6975 *      prj->prjx2s  Pointer to cscx2s().
6976 *      prj->prjs2x  Pointer to cscs2x().
6977 *===========================================================================*/
6978 
cscset(struct prjprm * prj)6979 int cscset(struct prjprm *prj)
6980 
6981 {
6982   if (prj == 0x0) return PRJERR_NULL_POINTER;
6983 
6984   prj->flag = CSC;
6985   strcpy(prj->code, "CSC");
6986 
6987   strcpy(prj->name, "COBE quadrilateralized spherical cube");
6988   prj->category  = QUADCUBE;
6989   prj->pvrange   = 0;
6990   prj->simplezen = 0;
6991   prj->equiareal = 0;
6992   prj->conformal = 0;
6993   prj->global    = 1;
6994   prj->divergent = 0;
6995 
6996   if (prj->r0 == 0.0) {
6997     prj->r0 = R2D;
6998     prj->w[0] = 45.0;
6999     prj->w[1] = 1.0/45.0;
7000   } else {
7001     prj->w[0] = prj->r0*PI/4.0;
7002     prj->w[1] = 1.0/prj->w[0];
7003   }
7004 
7005   prj->prjx2s = cscx2s;
7006   prj->prjs2x = cscs2x;
7007 
7008   return prjoff(prj, 0.0, 0.0);
7009 }
7010 
7011 //----------------------------------------------------------------------------
7012 
cscx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])7013 int cscx2s(
7014   struct prjprm *prj,
7015   int nx,
7016   int ny,
7017   int sxy,
7018   int spt,
7019   const double x[],
7020   const double y[],
7021   double phi[],
7022   double theta[],
7023   int stat[])
7024 
7025 {
7026   int face, mx, my, rowlen, rowoff, status;
7027   double l, m, n, t;
7028   register int ix, iy, *statp;
7029   register const double *xp, *yp;
7030   register double *phip, *thetap;
7031 
7032   float chi, psi, xf, xx, yf, yy, z0, z1, z2, z3, z4, z5, z6;
7033   const float p00 = -0.27292696f;
7034   const float p10 = -0.07629969f;
7035   const float p20 = -0.22797056f;
7036   const float p30 =  0.54852384f;
7037   const float p40 = -0.62930065f;
7038   const float p50 =  0.25795794f;
7039   const float p60 =  0.02584375f;
7040   const float p01 = -0.02819452f;
7041   const float p11 = -0.01471565f;
7042   const float p21 =  0.48051509f;
7043   const float p31 = -1.74114454f;
7044   const float p41 =  1.71547508f;
7045   const float p51 = -0.53022337f;
7046   const float p02 =  0.27058160f;
7047   const float p12 = -0.56800938f;
7048   const float p22 =  0.30803317f;
7049   const float p32 =  0.98938102f;
7050   const float p42 = -0.83180469f;
7051   const float p03 = -0.60441560f;
7052   const float p13 =  1.50880086f;
7053   const float p23 = -0.93678576f;
7054   const float p33 =  0.08693841f;
7055   const float p04 =  0.93412077f;
7056   const float p14 = -1.41601920f;
7057   const float p24 =  0.33887446f;
7058   const float p05 = -0.63915306f;
7059   const float p15 =  0.52032238f;
7060   const float p06 =  0.14381585f;
7061 
7062   // Initialize.
7063   if (prj == 0x0) return PRJERR_NULL_POINTER;
7064   if (prj->flag != CSC) {
7065     if ((status = cscset(prj))) return status;
7066   }
7067 
7068   if (ny > 0) {
7069     mx = nx;
7070     my = ny;
7071   } else {
7072     mx = 1;
7073     my = 1;
7074     ny = nx;
7075   }
7076 
7077   status = 0;
7078 
7079 
7080   // Do x dependence.
7081   xp = x;
7082   rowoff = 0;
7083   rowlen = nx*spt;
7084   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
7085     xf = (float)((*xp + prj->x0)*prj->w[1]);
7086 
7087     phip = phi + rowoff;
7088     for (iy = 0; iy < my; iy++) {
7089       *phip = xf;
7090       phip += rowlen;
7091     }
7092   }
7093 
7094 
7095   // Do y dependence.
7096   yp = y;
7097   phip   = phi;
7098   thetap = theta;
7099   statp  = stat;
7100   for (iy = 0; iy < ny; iy++, yp += sxy) {
7101     yf = (float)((*yp + prj->y0)*prj->w[1]);
7102 
7103     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
7104       xf = (float)(*phip);
7105 
7106       // Bounds checking.
7107       if (fabs((double)xf) <= 1.0) {
7108         if (fabs((double)yf) > 3.0) {
7109           *phip = 0.0;
7110           *thetap = 0.0;
7111           *(statp++) = 1;
7112           if (!status) status = PRJERR_BAD_PIX_SET("cscx2s");
7113           continue;
7114         }
7115       } else {
7116         if (fabs((double)xf) > 7.0 || fabs((double)yf) > 1.0) {
7117           *phip = 0.0;
7118           *thetap = 0.0;
7119           *(statp++) = 1;
7120           if (!status) status = PRJERR_BAD_PIX_SET("cscx2s");
7121           continue;
7122         }
7123       }
7124 
7125       // Map negative faces to the other side.
7126       if (xf < -1.0f) xf += 8.0f;
7127 
7128       // Determine the face.
7129       if (xf > 5.0f) {
7130         face = 4;
7131         xf = xf - 6.0f;
7132       } else if (xf > 3.0f) {
7133         face = 3;
7134         xf = xf - 4.0f;
7135       } else if (xf > 1.0f) {
7136         face = 2;
7137         xf = xf - 2.0f;
7138       } else if (yf > 1.0f) {
7139         face = 0;
7140         yf = yf - 2.0f;
7141       } else if (yf < -1.0f) {
7142         face = 5;
7143         yf = yf + 2.0f;
7144       } else {
7145         face = 1;
7146       }
7147 
7148       xx  =  xf*xf;
7149       yy  =  yf*yf;
7150 
7151       z0 = p00 + xx*(p10 + xx*(p20 + xx*(p30 + xx*(p40 + xx*(p50 +
7152                  xx*(p60))))));
7153       z1 = p01 + xx*(p11 + xx*(p21 + xx*(p31 + xx*(p41 + xx*(p51)))));
7154       z2 = p02 + xx*(p12 + xx*(p22 + xx*(p32 + xx*(p42))));
7155       z3 = p03 + xx*(p13 + xx*(p23 + xx*(p33)));
7156       z4 = p04 + xx*(p14 + xx*(p24));
7157       z5 = p05 + xx*(p15);
7158       z6 = p06;
7159 
7160       chi = z0 + yy*(z1 + yy*(z2 + yy*(z3 + yy*(z4 + yy*(z5 + yy*z6)))));
7161       chi = xf + xf*(1.0f - xx)*chi;
7162 
7163       z0 = p00 + yy*(p10 + yy*(p20 + yy*(p30 + yy*(p40 + yy*(p50 +
7164                  yy*(p60))))));
7165       z1 = p01 + yy*(p11 + yy*(p21 + yy*(p31 + yy*(p41 + yy*(p51)))));
7166       z2 = p02 + yy*(p12 + yy*(p22 + yy*(p32 + yy*(p42))));
7167       z3 = p03 + yy*(p13 + yy*(p23 + yy*(p33)));
7168       z4 = p04 + yy*(p14 + yy*(p24));
7169       z5 = p05 + yy*(p15);
7170       z6 = p06;
7171 
7172       psi = z0 + xx*(z1 + xx*(z2 + xx*(z3 + xx*(z4 + xx*(z5 + xx*z6)))));
7173       psi = yf + yf*(1.0f - yy)*psi;
7174 
7175       t = 1.0/sqrt((double)(chi*chi + psi*psi) + 1.0);
7176       switch (face) {
7177       case 1:
7178         l =  t;
7179         m =  chi*l;
7180         n =  psi*l;
7181         break;
7182       case 2:
7183         m =  t;
7184         l = -chi*m;
7185         n =  psi*m;
7186         break;
7187       case 3:
7188         l = -t;
7189         m =  chi*l;
7190         n = -psi*l;
7191         break;
7192       case 4:
7193         m = -t;
7194         l = -chi*m;
7195         n = -psi*m;
7196         break;
7197       case 5:
7198         n = -t;
7199         l = -psi*n;
7200         m = -chi*n;
7201         break;
7202       default:
7203         // face == 0
7204         n =  t;
7205         l = -psi*n;
7206         m =  chi*n;
7207         break;
7208       }
7209 
7210       if (l == 0.0 && m == 0.0) {
7211         *phip = 0.0;
7212       } else {
7213         *phip = atan2d(m, l);
7214       }
7215 
7216       *thetap = asind(n);
7217       *(statp++) = 0;
7218     }
7219   }
7220 
7221 
7222   // Do bounds checking on the native coordinates.
7223   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
7224     if (!status) status = PRJERR_BAD_PIX_SET("cscx2s");
7225   }
7226 
7227   return status;
7228 }
7229 
7230 //----------------------------------------------------------------------------
7231 
cscs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])7232 int cscs2x(
7233   struct prjprm *prj,
7234   int nphi,
7235   int ntheta,
7236   int spt,
7237   int sxy,
7238   const double phi[],
7239   const double theta[],
7240   double x[],
7241   double y[],
7242   int stat[])
7243 
7244 {
7245   int face, mphi, mtheta, rowlen, rowoff, status;
7246   double cosphi, costhe, eta, l, m, n, sinphi, sinthe, xi, zeta;
7247   const double tol = 1.0e-7;
7248   register int iphi, istat, itheta, *statp;
7249   register const double *phip, *thetap;
7250   register double *xp, *yp;
7251 
7252   float chi, chi2, chi2psi2, chi4, chipsi, psi, psi2, psi4, chi2co, psi2co,
7253         x0, xf, y0, yf;
7254   const float gstar  =  1.37484847732f;
7255   const float mm     =  0.004869491981f;
7256   const float gamma  = -0.13161671474f;
7257   const float omega1 = -0.159596235474f;
7258   const float d0  =  0.0759196200467f;
7259   const float d1  = -0.0217762490699f;
7260   const float c00 =  0.141189631152f;
7261   const float c10 =  0.0809701286525f;
7262   const float c01 = -0.281528535557f;
7263   const float c11 =  0.15384112876f;
7264   const float c20 = -0.178251207466f;
7265   const float c02 =  0.106959469314f;
7266 
7267 
7268   // Initialize.
7269   if (prj == 0x0) return PRJERR_NULL_POINTER;
7270   if (prj->flag != CSC) {
7271     if ((status = cscset(prj))) return status;
7272   }
7273 
7274   if (ntheta > 0) {
7275     mphi   = nphi;
7276     mtheta = ntheta;
7277   } else {
7278     mphi   = 1;
7279     mtheta = 1;
7280     ntheta = nphi;
7281   }
7282 
7283   status = 0;
7284 
7285 
7286   // Do phi dependence.
7287   phip = phi;
7288   rowoff = 0;
7289   rowlen = nphi*sxy;
7290   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
7291     sincosd(*phip, &sinphi, &cosphi);
7292 
7293     xp = x + rowoff;
7294     yp = y + rowoff;
7295     for (itheta = 0; itheta < mtheta; itheta++) {
7296       *xp = cosphi;
7297       *yp = sinphi;
7298       xp += rowlen;
7299       yp += rowlen;
7300     }
7301   }
7302 
7303 
7304   // Do theta dependence.
7305   thetap = theta;
7306   xp = x;
7307   yp = y;
7308   statp = stat;
7309   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
7310     sincosd(*thetap, &sinthe, &costhe);
7311 
7312     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
7313       l = costhe*(*xp);
7314       m = costhe*(*yp);
7315       n = sinthe;
7316 
7317       face = 0;
7318       zeta = n;
7319       if (l > zeta) {
7320         face = 1;
7321         zeta = l;
7322       }
7323       if (m > zeta) {
7324         face = 2;
7325         zeta = m;
7326       }
7327       if (-l > zeta) {
7328         face = 3;
7329         zeta = -l;
7330       }
7331       if (-m > zeta) {
7332         face = 4;
7333         zeta = -m;
7334       }
7335       if (-n > zeta) {
7336         face = 5;
7337         zeta = -n;
7338       }
7339 
7340       switch (face) {
7341       case 1:
7342         xi  =  m;
7343         eta =  n;
7344         x0  =  0.0;
7345         y0  =  0.0;
7346         break;
7347       case 2:
7348         xi  = -l;
7349         eta =  n;
7350         x0  =  2.0;
7351         y0  =  0.0;
7352         break;
7353       case 3:
7354         xi  = -m;
7355         eta =  n;
7356         x0  =  4.0;
7357         y0  =  0.0;
7358         break;
7359       case 4:
7360         xi  =  l;
7361         eta =  n;
7362         x0  =  6.0;
7363         y0  =  0.0;
7364         break;
7365       case 5:
7366         xi  =  m;
7367         eta =  l;
7368         x0  =  0.0;
7369         y0  = -2.0;
7370         break;
7371       default:
7372         // face == 0
7373         xi  =  m;
7374         eta = -l;
7375         x0  =  0.0;
7376         y0  =  2.0;
7377         break;
7378       }
7379 
7380       chi = (float)( xi/zeta);
7381       psi = (float)(eta/zeta);
7382 
7383       chi2 = chi*chi;
7384       psi2 = psi*psi;
7385       chi2co = 1.0f - chi2;
7386       psi2co = 1.0f - psi2;
7387 
7388       // Avoid floating underflows.
7389       chipsi = (float)fabs((double)(chi*psi));
7390       chi4   = (chi2 > 1.0e-16f) ? chi2*chi2 : 0.0f;
7391       psi4   = (psi2 > 1.0e-16f) ? psi2*psi2 : 0.0f;
7392       chi2psi2 = (chipsi > 1.0e-16f) ? chi2*psi2 : 0.0f;
7393 
7394       xf = chi*(chi2 + chi2co*(gstar + psi2*(gamma*chi2co + mm*chi2 +
7395                 psi2co*(c00 + c10*chi2 + c01*psi2 + c11*chi2psi2 + c20*chi4 +
7396                 c02*psi4)) + chi2*(omega1 - chi2co*(d0 + d1*chi2))));
7397       yf = psi*(psi2 + psi2co*(gstar + chi2*(gamma*psi2co + mm*psi2 +
7398                 chi2co*(c00 + c10*psi2 + c01*chi2 + c11*chi2psi2 + c20*psi4 +
7399                 c02*chi4)) + psi2*(omega1 - psi2co*(d0 + d1*psi2))));
7400 
7401       istat = 0;
7402       if (fabs((double)xf) > 1.0) {
7403         if (fabs((double)xf) > 1.0+tol) {
7404           istat = 1;
7405           if (!status) status = PRJERR_BAD_WORLD_SET("cscs2x");
7406         }
7407         xf = (float)copysign(1.0, (double)xf);
7408       }
7409       if (fabs((double)yf) > 1.0) {
7410         if (fabs((double)yf) > 1.0+tol) {
7411           istat = 1;
7412           if (!status) status = PRJERR_BAD_WORLD_SET("cscs2x");
7413         }
7414         yf = (float)copysign(1.0, (double)yf);
7415       }
7416 
7417       *xp = prj->w[0]*(xf + x0) - prj->x0;
7418       *yp = prj->w[0]*(yf + y0) - prj->y0;
7419       *(statp++) = istat;
7420     }
7421   }
7422 
7423   return status;
7424 }
7425 
7426 /*============================================================================
7427 *   QSC: quadrilaterilized spherical cube projection.
7428 *
7429 *   Given and/or returned:
7430 *      prj->r0      Reset to 180/pi if 0.
7431 *      prj->phi0    Reset to 0.0 if undefined.
7432 *      prj->theta0  Reset to 0.0 if undefined.
7433 *
7434 *   Returned:
7435 *      prj->flag     QSC
7436 *      prj->code    "QSC"
7437 *      prj->x0      Fiducial offset in x.
7438 *      prj->y0      Fiducial offset in y.
7439 *      prj->w[0]    r0*(pi/4)
7440 *      prj->w[1]    (4/pi)/r0
7441 *      prj->prjx2s  Pointer to qscx2s().
7442 *      prj->prjs2x  Pointer to qscs2x().
7443 *===========================================================================*/
7444 
qscset(struct prjprm * prj)7445 int qscset(struct prjprm *prj)
7446 
7447 {
7448   if (prj == 0x0) return PRJERR_NULL_POINTER;
7449 
7450   prj->flag = QSC;
7451   strcpy(prj->code, "QSC");
7452 
7453   strcpy(prj->name, "quadrilateralized spherical cube");
7454   prj->category  = QUADCUBE;
7455   prj->pvrange   = 0;
7456   prj->simplezen = 0;
7457   prj->equiareal = 1;
7458   prj->conformal = 0;
7459   prj->global    = 1;
7460   prj->divergent = 0;
7461 
7462   if (prj->r0 == 0.0) {
7463     prj->r0 = R2D;
7464     prj->w[0] = 45.0;
7465     prj->w[1] = 1.0/45.0;
7466   } else {
7467     prj->w[0] = prj->r0*PI/4.0;
7468     prj->w[1] = 1.0/prj->w[0];
7469   }
7470 
7471   prj->prjx2s = qscx2s;
7472   prj->prjs2x = qscs2x;
7473 
7474   return prjoff(prj, 0.0, 0.0);
7475 }
7476 
7477 //----------------------------------------------------------------------------
7478 
qscx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])7479 int qscx2s(
7480   struct prjprm *prj,
7481   int nx,
7482   int ny,
7483   int sxy,
7484   int spt,
7485   const double x[],
7486   const double y[],
7487   double phi[],
7488   double theta[],
7489   int stat[])
7490 
7491 {
7492   int direct, face, mx, my, rowlen, rowoff, status;
7493   double cosw, l, m, n, omega, sinw, tau, xf, yf, w, zeco, zeta;
7494   const double tol = 1.0e-12;
7495   register int ix, iy, *statp;
7496   register const double *xp, *yp;
7497   register double *phip, *thetap;
7498 
7499 
7500   // Initialize.
7501   if (prj == 0x0) return PRJERR_NULL_POINTER;
7502   if (prj->flag != QSC) {
7503     if ((status = qscset(prj))) return status;
7504   }
7505 
7506   if (ny > 0) {
7507     mx = nx;
7508     my = ny;
7509   } else {
7510     mx = 1;
7511     my = 1;
7512     ny = nx;
7513   }
7514 
7515   status = 0;
7516 
7517 
7518   // Do x dependence.
7519   xp = x;
7520   rowoff = 0;
7521   rowlen = nx*spt;
7522   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
7523     xf = (*xp + prj->x0)*prj->w[1];
7524 
7525     phip = phi + rowoff;
7526     for (iy = 0; iy < my; iy++) {
7527       *phip = xf;
7528       phip += rowlen;
7529     }
7530   }
7531 
7532 
7533   // Do y dependence.
7534   yp = y;
7535   phip   = phi;
7536   thetap = theta;
7537   statp  = stat;
7538   for (iy = 0; iy < ny; iy++, yp += sxy) {
7539     yf = (*yp + prj->y0)*prj->w[1];
7540 
7541     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
7542       xf = *phip;
7543 
7544       // Bounds checking.
7545       if (fabs(xf) <= 1.0) {
7546         if (fabs(yf) > 3.0) {
7547           *phip = 0.0;
7548           *thetap = 0.0;
7549           *(statp++) = 1;
7550           if (!status) status = PRJERR_BAD_PIX_SET("qscx2s");
7551           continue;
7552         }
7553       } else {
7554         if (fabs(xf) > 7.0 || fabs(yf) > 1.0) {
7555           *phip = 0.0;
7556           *thetap = 0.0;
7557           *(statp++) = 1;
7558           if (!status) status = PRJERR_BAD_PIX_SET("qscx2s");
7559           continue;
7560         }
7561       }
7562 
7563       // Map negative faces to the other side.
7564       if (xf < -1.0) xf += 8.0;
7565 
7566       // Determine the face.
7567       if (xf > 5.0) {
7568         face = 4;
7569         xf -= 6.0;
7570       } else if (xf > 3.0) {
7571         face = 3;
7572         xf -= 4.0;
7573       } else if (xf > 1.0) {
7574         face = 2;
7575         xf -= 2.0;
7576       } else if (yf > 1.0) {
7577         face = 0;
7578         yf -= 2.0;
7579       } else if (yf < -1.0) {
7580         face = 5;
7581         yf += 2.0;
7582       } else {
7583         face = 1;
7584       }
7585 
7586       direct = (fabs(xf) > fabs(yf));
7587       if (direct) {
7588         if (xf == 0.0) {
7589           omega = 0.0;
7590           tau  = 1.0;
7591           zeta = 1.0;
7592           zeco = 0.0;
7593         } else {
7594           w = 15.0*yf/xf;
7595           omega = sind(w)/(cosd(w) - SQRT2INV);
7596           tau  = 1.0 + omega*omega;
7597           zeco = xf*xf*(1.0 - 1.0/sqrt(1.0 + tau));
7598           zeta = 1.0 - zeco;
7599         }
7600       } else {
7601         if (yf == 0.0) {
7602           omega = 0.0;
7603           tau  = 1.0;
7604           zeta = 1.0;
7605           zeco = 0.0;
7606         } else {
7607           w = 15.0*xf/yf;
7608           sincosd(w, &sinw, &cosw);
7609           omega = sinw/(cosw - SQRT2INV);
7610           tau  = 1.0 + omega*omega;
7611           zeco = yf*yf*(1.0 - 1.0/sqrt(1.0 + tau));
7612           zeta = 1.0 - zeco;
7613         }
7614       }
7615 
7616       if (zeta < -1.0) {
7617         if (zeta < -1.0-tol) {
7618           *phip = 0.0;
7619           *thetap = 0.0;
7620           *(statp++) = 1;
7621           if (!status) status = PRJERR_BAD_PIX_SET("qscx2s");
7622           continue;
7623         }
7624 
7625         zeta = -1.0;
7626         zeco =  2.0;
7627         w    =  0.0;
7628       } else {
7629         w = sqrt(zeco*(2.0-zeco)/tau);
7630       }
7631 
7632       switch (face) {
7633       case 1:
7634         l = zeta;
7635         if (direct) {
7636           m = w;
7637           if (xf < 0.0) m = -m;
7638           n = m*omega;
7639         } else {
7640           n = w;
7641           if (yf < 0.0) n = -n;
7642           m = n*omega;
7643         }
7644         break;
7645       case 2:
7646         m = zeta;
7647         if (direct) {
7648           l = w;
7649           if (xf > 0.0) l = -l;
7650           n = -l*omega;
7651         } else {
7652           n = w;
7653           if (yf < 0.0) n = -n;
7654           l = -n*omega;
7655         }
7656         break;
7657       case 3:
7658         l = -zeta;
7659         if (direct) {
7660           m = w;
7661           if (xf > 0.0) m = -m;
7662           n = -m*omega;
7663         } else {
7664           n = w;
7665           if (yf < 0.0) n = -n;
7666           m = -n*omega;
7667         }
7668         break;
7669       case 4:
7670         m = -zeta;
7671         if (direct) {
7672           l = w;
7673           if (xf < 0.0) l = -l;
7674           n = l*omega;
7675         } else {
7676           n = w;
7677           if (yf < 0.0) n = -n;
7678           l = n*omega;
7679         }
7680         break;
7681       case 5:
7682         n = -zeta;
7683         if (direct) {
7684           m = w;
7685           if (xf < 0.0) m = -m;
7686           l = m*omega;
7687         } else {
7688           l = w;
7689           if (yf < 0.0) l = -l;
7690           m = l*omega;
7691         }
7692         break;
7693       default:
7694         // face == 0
7695         n = zeta;
7696         if (direct) {
7697           m = w;
7698           if (xf < 0.0) m = -m;
7699           l = -m*omega;
7700         } else {
7701           l = w;
7702           if (yf > 0.0) l = -l;
7703           m = -l*omega;
7704         }
7705         break;
7706       }
7707 
7708       if (l == 0.0 && m == 0.0) {
7709         *phip = 0.0;
7710       } else {
7711         *phip = atan2d(m, l);
7712       }
7713 
7714       *thetap = asind(n);
7715       *(statp++) = 0;
7716     }
7717   }
7718 
7719 
7720   // Do bounds checking on the native coordinates.
7721   if (prj->bounds&4 && prjbchk(1.0e-13, nx, my, spt, phi, theta, stat)) {
7722     if (!status) status = PRJERR_BAD_PIX_SET("qscx2s");
7723   }
7724 
7725   return status;
7726 }
7727 
7728 //----------------------------------------------------------------------------
7729 
qscs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])7730 int qscs2x(
7731   struct prjprm *prj,
7732   int nphi,
7733   int ntheta,
7734   int spt,
7735   int sxy,
7736   const double phi[],
7737   const double theta[],
7738   double x[],
7739   double y[],
7740   int stat[])
7741 
7742 {
7743   int face, mphi, mtheta, rowlen, rowoff, status;
7744   double cosphi, costhe, eta, l, m, n, omega, p, sinphi, sinthe, t, tau, x0,
7745          xf, xi, y0, yf, zeco, zeta;
7746   const double tol = 1.0e-12;
7747   register int iphi, istat, itheta, *statp;
7748   register const double *phip, *thetap;
7749   register double *xp, *yp;
7750 
7751 
7752   // Initialize.
7753   if (prj == 0x0) return PRJERR_NULL_POINTER;
7754   if (prj->flag != QSC) {
7755     if ((status = qscset(prj))) return status;
7756   }
7757 
7758   if (ntheta > 0) {
7759     mphi   = nphi;
7760     mtheta = ntheta;
7761   } else {
7762     mphi   = 1;
7763     mtheta = 1;
7764     ntheta = nphi;
7765   }
7766 
7767   status = 0;
7768 
7769 
7770   // Do phi dependence.
7771   phip = phi;
7772   rowoff = 0;
7773   rowlen = nphi*sxy;
7774   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
7775     sincosd(*phip, &sinphi, &cosphi);
7776 
7777     xp = x + rowoff;
7778     yp = y + rowoff;
7779     for (itheta = 0; itheta < mtheta; itheta++) {
7780       *xp = cosphi;
7781       *yp = sinphi;
7782       xp += rowlen;
7783       yp += rowlen;
7784     }
7785   }
7786 
7787 
7788   // Do theta dependence.
7789   thetap = theta;
7790   xp = x;
7791   yp = y;
7792   statp = stat;
7793   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
7794     sincosd(*thetap, &sinthe, &costhe);
7795 
7796     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
7797       if (fabs(*thetap) == 90.0) {
7798         *xp = -prj->x0;
7799         *yp = copysign(2.0*prj->w[0], *thetap) - prj->y0;
7800         *(statp++) = 0;
7801         continue;
7802       }
7803 
7804       l = costhe*(*xp);
7805       m = costhe*(*yp);
7806       n = sinthe;
7807 
7808       face = 0;
7809       zeta = n;
7810       if (l > zeta) {
7811         face = 1;
7812         zeta = l;
7813       }
7814       if (m > zeta) {
7815         face = 2;
7816         zeta = m;
7817       }
7818       if (-l > zeta) {
7819         face = 3;
7820         zeta = -l;
7821       }
7822       if (-m > zeta) {
7823         face = 4;
7824         zeta = -m;
7825       }
7826       if (-n > zeta) {
7827         face = 5;
7828         zeta = -n;
7829       }
7830 
7831       zeco = 1.0 - zeta;
7832 
7833       switch (face) {
7834       case 1:
7835         xi  = m;
7836         eta = n;
7837         if (zeco < 1.0e-8) {
7838           // Small angle formula.
7839           t = (*thetap)*D2R;
7840           p = atan2(*yp, *xp);
7841           zeco = (p*p + t*t)/2.0;
7842         }
7843         x0 = 0.0;
7844         y0 = 0.0;
7845         break;
7846       case 2:
7847         xi  = -l;
7848         eta =  n;
7849         if (zeco < 1.0e-8) {
7850           // Small angle formula.
7851           t = (*thetap)*D2R;
7852           p = atan2(*yp, *xp) - PI/2.0;
7853           zeco = (p*p + t*t)/2.0;
7854         }
7855         x0 = 2.0;
7856         y0 = 0.0;
7857         break;
7858       case 3:
7859         xi  = -m;
7860         eta =  n;
7861         if (zeco < 1.0e-8) {
7862           // Small angle formula.
7863           t = (*thetap)*D2R;
7864           p = atan2(*yp, *xp);
7865           p -= copysign(PI, p);
7866           zeco = (p*p + t*t)/2.0;
7867         }
7868         x0 = 4.0;
7869         y0 = 0.0;
7870         break;
7871       case 4:
7872         xi  = l;
7873         eta = n;
7874         if (zeco < 1.0e-8) {
7875           // Small angle formula.
7876           t = (*thetap)*D2R;
7877           p = atan2(*yp, *xp) + PI/2.0;
7878           zeco = (p*p + t*t)/2.0;
7879         }
7880         x0 = 6;
7881         y0 = 0.0;
7882         break;
7883       case 5:
7884         xi  =  m;
7885         eta =  l;
7886         if (zeco < 1.0e-8) {
7887           // Small angle formula.
7888           t = (*thetap + 90.0)*D2R;
7889           zeco = t*t/2.0;
7890         }
7891         x0 =  0.0;
7892         y0 = -2;
7893          break;
7894       default:
7895         // face == 0
7896         xi  =  m;
7897         eta = -l;
7898         if (zeco < 1.0e-8) {
7899           // Small angle formula.
7900           t = (90.0 - *thetap)*D2R;
7901           zeco = t*t/2.0;
7902         }
7903         x0 = 0.0;
7904         y0 = 2.0;
7905         break;
7906       }
7907 
7908       xf = 0.0;
7909       yf = 0.0;
7910       if (xi != 0.0 || eta != 0.0) {
7911         if (-xi > fabs(eta)) {
7912           omega = eta/xi;
7913           tau = 1.0 + omega*omega;
7914           xf  = -sqrt(zeco/(1.0 - 1.0/sqrt(1.0+tau)));
7915           yf  = (xf/15.0)*(atand(omega) - asind(omega/sqrt(tau+tau)));
7916         } else if (xi > fabs(eta)) {
7917           omega = eta/xi;
7918           tau = 1.0 + omega*omega;
7919           xf  =  sqrt(zeco/(1.0 - 1.0/sqrt(1.0+tau)));
7920           yf  = (xf/15.0)*(atand(omega) - asind(omega/sqrt(tau+tau)));
7921         } else if (-eta >= fabs(xi)) {
7922           omega = xi/eta;
7923           tau = 1.0 + omega*omega;
7924           yf  = -sqrt(zeco/(1.0 - 1.0/sqrt(1.0+tau)));
7925           xf  = (yf/15.0)*(atand(omega) - asind(omega/sqrt(tau+tau)));
7926         } else if (eta >= fabs(xi)) {
7927           omega = xi/eta;
7928           tau = 1.0 + omega*omega;
7929           yf  =  sqrt(zeco/(1.0 - 1.0/sqrt(1.0+tau)));
7930           xf  = (yf/15.0)*(atand(omega) - asind(omega/sqrt(tau+tau)));
7931         }
7932       }
7933 
7934       istat = 0;
7935       if (fabs(xf) > 1.0) {
7936         if (fabs(xf) > 1.0+tol) {
7937           istat = 1;
7938           if (!status) status = PRJERR_BAD_WORLD_SET("qscs2x");
7939         }
7940         xf = copysign(1.0, xf);
7941       }
7942       if (fabs(yf) > 1.0) {
7943         if (fabs(yf) > 1.0+tol) {
7944           istat = 1;
7945           if (!status) status = PRJERR_BAD_WORLD_SET("qscs2x");
7946         }
7947         yf = copysign(1.0, yf);
7948       }
7949 
7950       *xp = prj->w[0]*(xf + x0) - prj->x0;
7951       *yp = prj->w[0]*(yf + y0) - prj->y0;
7952       *(statp++) = istat;
7953     }
7954   }
7955 
7956   return status;
7957 }
7958 
7959 /*============================================================================
7960 *   HPX: HEALPix projection.
7961 *
7962 *   Given:
7963 *      prj->pv[1]   H - the number of facets in longitude.
7964 *      prj->pv[2]   K - the number of facets in latitude
7965 *
7966 *   Given and/or returned:
7967 *      prj->r0      Reset to 180/pi if 0.
7968 *      prj->phi0    Reset to 0.0 if undefined.
7969 *      prj->theta0  Reset to 0.0 if undefined.
7970 *
7971 *   Returned:
7972 *      prj->flag     HPX
7973 *      prj->code    "HPX"
7974 *      prj->x0      Fiducial offset in x.
7975 *      prj->y0      Fiducial offset in y.
7976 *      prj->m       True if H is odd.
7977 *      prj->n       True if K is odd.
7978 *      prj->w[0]    r0*(pi/180)
7979 *      prj->w[1]    (180/pi)/r0
7980 *      prj->w[2]    (K-1)/K
7981 *      prj->w[3]    90*K/H
7982 *      prj->w[4]    (K+1)/2
7983 *      prj->w[5]    90*(K-1)/H
7984 *      prj->w[6]    180/H
7985 *      prj->w[7]    H/360
7986 *      prj->w[8]    r0*(pi/180)*(90*K/H)
7987 *      prj->w[9]    r0*(pi/180)*(180/H)
7988 *      prj->prjx2s  Pointer to hpxx2s().
7989 *      prj->prjs2x  Pointer to hpxs2x().
7990 *===========================================================================*/
7991 
hpxset(struct prjprm * prj)7992 int hpxset(struct prjprm *prj)
7993 
7994 {
7995   if (prj == 0x0) return PRJERR_NULL_POINTER;
7996 
7997   prj->flag = HPX;
7998   strcpy(prj->code, "HPX");
7999 
8000   if (undefined(prj->pv[1])) prj->pv[1] = 4.0;
8001   if (undefined(prj->pv[2])) prj->pv[2] = 3.0;
8002 
8003   strcpy(prj->name, "HEALPix");
8004   prj->category  = HEALPIX;
8005   prj->pvrange   = 102;
8006   prj->simplezen = 0;
8007   prj->equiareal = 1;
8008   prj->conformal = 0;
8009   prj->global    = 1;
8010   prj->divergent = 0;
8011 
8012   if (prj->pv[1] <= 0.0 || prj->pv[2] <= 0.0) {
8013     return PRJERR_BAD_PARAM_SET("hpxset");
8014   }
8015 
8016   prj->m = ((int)(prj->pv[1]+0.5))%2;
8017   prj->n = ((int)(prj->pv[2]+0.5))%2;
8018 
8019   if (prj->r0 == 0.0) {
8020     prj->r0 = R2D;
8021     prj->w[0] = 1.0;
8022     prj->w[1] = 1.0;
8023   } else {
8024     prj->w[0] = prj->r0*D2R;
8025     prj->w[1] = R2D/prj->r0;
8026   }
8027 
8028   prj->w[2] = (prj->pv[2] - 1.0) / prj->pv[2];
8029   prj->w[3] = 90.0 * prj->pv[2] / prj->pv[1];
8030   prj->w[4] = (prj->pv[2] + 1.0) / 2.0;
8031   prj->w[5] = 90.0 * (prj->pv[2] - 1.0) / prj->pv[1];
8032   prj->w[6] = 180.0 / prj->pv[1];
8033   prj->w[7] = prj->pv[1] / 360.0;
8034   prj->w[8] = prj->w[3] * prj->w[0];
8035   prj->w[9] = prj->w[6] * prj->w[0];
8036 
8037   prj->prjx2s = hpxx2s;
8038   prj->prjs2x = hpxs2x;
8039 
8040   return prjoff(prj, 0.0, 0.0);
8041 }
8042 
8043 //----------------------------------------------------------------------------
8044 
hpxx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])8045 int hpxx2s(
8046   struct prjprm *prj,
8047   int nx,
8048   int ny,
8049   int sxy,
8050   int spt,
8051   const double x[],
8052   const double y[],
8053   double phi[],
8054   double theta[],
8055   int stat[])
8056 
8057 {
8058   int h, mx, my, offset, rowlen, rowoff, status;
8059   double absy, r, s, sigma, slim, t, ylim, yr;
8060   register int istat, ix, iy, *statp;
8061   register const double *xp, *yp;
8062   register double *phip, *thetap;
8063 
8064 
8065   // Initialize.
8066   if (prj == 0x0) return PRJERR_NULL_POINTER;
8067   if (prj->flag != HPX) {
8068     if ((status = hpxset(prj))) return status;
8069   }
8070 
8071   slim = prj->w[6] + 1e-12;
8072   ylim = prj->w[9] * prj->w[4];
8073 
8074   if (ny > 0) {
8075     mx = nx;
8076     my = ny;
8077   } else {
8078     mx = 1;
8079     my = 1;
8080     ny = nx;
8081   }
8082 
8083   status = 0;
8084 
8085 
8086   // Do x dependence.
8087   xp = x;
8088   rowoff = 0;
8089   rowlen = nx*spt;
8090   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
8091     s = prj->w[1] * (*xp + prj->x0);
8092     // x_c for K odd or theta > 0.
8093     t = -180.0 + (2.0 * floor((*xp + 180.0) * prj->w[7]) + 1.0) * prj->w[6];
8094     t = prj->w[1] * (*xp - t);
8095 
8096     phip   = phi + rowoff;
8097     thetap = theta + rowoff;
8098     for (iy = 0; iy < my; iy++) {
8099       // theta[] is used to hold (x - x_c).
8100       *phip   = s;
8101       *thetap = t;
8102       phip   += rowlen;
8103       thetap += rowlen;
8104     }
8105   }
8106 
8107 
8108   // Do y dependence.
8109   yp = y;
8110   phip   = phi;
8111   thetap = theta;
8112   statp  = stat;
8113   for (iy = 0; iy < ny; iy++, yp += sxy) {
8114     yr = prj->w[1]*(*yp + prj->y0);
8115     absy = fabs(yr);
8116 
8117     istat = 0;
8118     if (absy <= prj->w[5]) {
8119       // Equatorial regime.
8120       t = asind(yr/prj->w[3]);
8121       for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
8122         *thetap = t;
8123         *(statp++) = 0;
8124       }
8125 
8126     } else if (absy <= ylim) {
8127       // Polar regime.
8128       offset = (prj->n || *yp > 0.0) ? 0 : 1;
8129 
8130       sigma = prj->w[4] - absy / prj->w[6];
8131 
8132       if (sigma == 0.0) {
8133         s = 1e9;
8134         t = 90.0;
8135 
8136       } else {
8137         t = 1.0 - sigma*sigma/prj->pv[2];
8138         if (t < -1.0) {
8139           s = 0.0;
8140           t = 0.0;
8141           istat = 1;
8142           if (!status) status = PRJERR_BAD_PIX_SET("hpxx2s");
8143         } else {
8144           s = 1.0/sigma;
8145           t = asind(t);
8146         }
8147       }
8148       if (*yp < 0.0) t = -t;
8149 
8150       for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
8151         if (offset) {
8152           // Offset the southern polar half-facets for even K.
8153           h = (int)floor(*phip / prj->w[6]) + prj->m;
8154           if (h%2) {
8155             *thetap -= prj->w[6];
8156           } else {
8157             *thetap += prj->w[6];
8158           }
8159         }
8160 
8161         // Recall that theta[] holds (x - x_c).
8162         r = s * *thetap;
8163 
8164         // Bounds checking.
8165         if (prj->bounds&2) {
8166           if (slim <= fabs(r)) {
8167             istat = 1;
8168             if (!status) status = PRJERR_BAD_PIX_SET("hpxx2s");
8169           }
8170         }
8171 
8172         if (r != 0.0) r -= *thetap;
8173         *phip  += r;
8174         *thetap = t;
8175 
8176         *(statp++) = istat;
8177       }
8178 
8179     } else {
8180       // Beyond latitude range.
8181       for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
8182         *phip   = 0.0;
8183         *thetap = 0.0;
8184         *(statp++) = 1;
8185       }
8186       if (!status) status = PRJERR_BAD_PIX_SET("hpxx2s");
8187     }
8188   }
8189 
8190 
8191   // Do bounds checking on the native coordinates.
8192   if (prj->bounds&4 && prjbchk(1.0e-12, nx, my, spt, phi, theta, stat)) {
8193     if (!status) status = PRJERR_BAD_PIX_SET("hpxx2s");
8194   }
8195 
8196   return status;
8197 }
8198 
8199 //----------------------------------------------------------------------------
8200 
hpxs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])8201 int hpxs2x(
8202   struct prjprm *prj,
8203   int nphi,
8204   int ntheta,
8205   int spt,
8206   int sxy,
8207   const double phi[],
8208   const double theta[],
8209   double x[],
8210   double y[],
8211   int stat[])
8212 
8213 {
8214   int h, mphi, mtheta, offset, rowlen, rowoff, status;
8215   double abssin, eta, sigma, sinthe, t, xi;
8216   register int iphi, itheta, *statp;
8217   register const double *phip, *thetap;
8218   register double *xp, *yp;
8219 
8220 
8221   // Initialize.
8222   if (prj == 0x0) return PRJERR_NULL_POINTER;
8223   if (prj->flag != HPX) {
8224     if ((status = hpxset(prj))) return status;
8225   }
8226 
8227   if (ntheta > 0) {
8228     mphi   = nphi;
8229     mtheta = ntheta;
8230   } else {
8231     mphi   = 1;
8232     mtheta = 1;
8233     ntheta = nphi;
8234   }
8235 
8236 
8237   // Do phi dependence.
8238   phip = phi;
8239   rowoff = 0;
8240   rowlen = nphi*sxy;
8241   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
8242     xi = prj->w[0] * (*phip) - prj->x0;
8243 
8244     // phi_c for K odd or theta > 0.
8245     t = -180.0 + (2.0*floor((*phip+180.0) * prj->w[7]) + 1.0) * prj->w[6];
8246     t = prj->w[0] * (*phip - t);
8247 
8248     xp = x + rowoff;
8249     yp = y + rowoff;
8250     for (itheta = 0; itheta < mtheta; itheta++) {
8251       // y[] is used to hold (phi - phi_c).
8252       *xp = xi;
8253       *yp = t;
8254       xp += rowlen;
8255       yp += rowlen;
8256     }
8257   }
8258 
8259 
8260   // Do theta dependence.
8261   thetap = theta;
8262   xp = x;
8263   yp = y;
8264   statp = stat;
8265   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
8266     sinthe = sind(*thetap);
8267     abssin = fabs(sinthe);
8268 
8269     if (abssin <= prj->w[2]) {
8270       // Equatorial regime.
8271       eta = prj->w[8] * sinthe - prj->y0;
8272       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
8273         *yp = eta;
8274         *(statp++) = 0;
8275       }
8276 
8277     } else {
8278       // Polar regime.
8279       offset = (prj->n || *thetap > 0.0) ? 0 : 1;
8280 
8281       sigma = sqrt(prj->pv[2]*(1.0 - abssin));
8282       xi = sigma - 1.0;
8283 
8284       eta = prj->w[9] * (prj->w[4] - sigma);
8285       if (*thetap < 0) eta = -eta;
8286       eta -= prj->y0;
8287 
8288       for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
8289         if (offset) {
8290           // Offset the southern polar half-facets for even K.
8291           h = (int)floor((*xp + prj->x0) / prj->w[9]) + prj->m;
8292           if (h%2) {
8293             *yp -= prj->w[9];
8294           } else {
8295             *yp += prj->w[9];
8296           }
8297         }
8298 
8299         // Recall that y[] holds (phi - phi_c).
8300         *xp += *yp * xi;
8301         *yp = eta;
8302         *(statp++) = 0;
8303 
8304         // Put the phi = 180 meridian in the expected place.
8305         if (180.0 < *xp) *xp = 360.0 - *xp;
8306       }
8307     }
8308   }
8309 
8310   return 0;
8311 }
8312 
8313 /*============================================================================
8314 *   XPH: HEALPix polar, aka "butterfly" projection.
8315 *
8316 *   Given and/or returned:
8317 *      prj->r0      Reset to 180/pi if 0.
8318 *      prj->phi0    Reset to 0.0 if undefined.
8319 *      prj->theta0  Reset to 0.0 if undefined.
8320 *
8321 *   Returned:
8322 *      prj->flag     XPH
8323 *      prj->code    "XPH"
8324 *      prj->x0      Fiducial offset in x.
8325 *      prj->y0      Fiducial offset in y.
8326 *      prj->w[0]    r0*(pi/180)/sqrt(2)
8327 *      prj->w[1]    (180/pi)/r0/sqrt(2)
8328 *      prj->w[2]    2/3
8329 *      prj->w[3]    tol (= 1e-4)
8330 *      prj->w[4]    sqrt(2/3)*(180/pi)
8331 *      prj->w[5]    90 - tol*sqrt(2/3)*(180/pi)
8332 *      prj->w[6]    sqrt(3/2)*(pi/180)
8333 *      prj->prjx2s  Pointer to xphx2s().
8334 *      prj->prjs2x  Pointer to xphs2x().
8335 *===========================================================================*/
8336 
xphset(struct prjprm * prj)8337 int xphset(struct prjprm *prj)
8338 
8339 {
8340   if (prj == 0x0) return PRJERR_NULL_POINTER;
8341 
8342   prj->flag = XPH;
8343   strcpy(prj->code, "XPH");
8344 
8345   strcpy(prj->name, "butterfly");
8346   prj->category  = HEALPIX;
8347   prj->pvrange   = 0;
8348   prj->simplezen = 0;
8349   prj->equiareal = 1;
8350   prj->conformal = 0;
8351   prj->global    = 1;
8352   prj->divergent = 0;
8353 
8354   if (prj->r0 == 0.0) {
8355     prj->r0 = R2D;
8356     prj->w[0] = 1.0;
8357     prj->w[1] = 1.0;
8358   } else {
8359     prj->w[0] = prj->r0*D2R;
8360     prj->w[1] = R2D/prj->r0;
8361   }
8362 
8363   prj->w[0] /= sqrt(2.0);
8364   prj->w[1] /= sqrt(2.0);
8365   prj->w[2]  = 2.0/3.0;
8366   prj->w[3]  = 1e-4;
8367   prj->w[4]  = sqrt(prj->w[2])*R2D;
8368   prj->w[5]  = 90.0 - prj->w[3]*prj->w[4];
8369   prj->w[6]  = sqrt(1.5)*D2R;
8370 
8371   prj->prjx2s = xphx2s;
8372   prj->prjs2x = xphs2x;
8373 
8374   return prjoff(prj, 0.0, 90.0);
8375 }
8376 
8377 //----------------------------------------------------------------------------
8378 
xphx2s(struct prjprm * prj,int nx,int ny,int sxy,int spt,const double x[],const double y[],double phi[],double theta[],int stat[])8379 int xphx2s(
8380   struct prjprm *prj,
8381   int nx,
8382   int ny,
8383   int sxy,
8384   int spt,
8385   const double x[],
8386   const double y[],
8387   double phi[],
8388   double theta[],
8389   int stat[])
8390 
8391 {
8392   int mx, my, rowlen, rowoff, status;
8393   double abseta, eta, eta1, sigma, xi, xi1, xr, yr;
8394   const double tol = 1.0e-12;
8395   register int istat, ix, iy, *statp;
8396   register const double *xp, *yp;
8397   register double *phip, *thetap;
8398 
8399 
8400   // Initialize.
8401   if (prj == 0x0) return PRJERR_NULL_POINTER;
8402   if (prj->flag != XPH) {
8403     if ((status = xphset(prj))) return status;
8404   }
8405 
8406   if (ny > 0) {
8407     mx = nx;
8408     my = ny;
8409   } else {
8410     mx = 1;
8411     my = 1;
8412     ny = nx;
8413   }
8414 
8415   status = 0;
8416 
8417 
8418   // Do x dependence.
8419   xp = x;
8420   rowoff = 0;
8421   rowlen = nx*spt;
8422   for (ix = 0; ix < nx; ix++, rowoff += spt, xp += sxy) {
8423     xr = (*xp + prj->x0)*prj->w[1];
8424 
8425     phip = phi + rowoff;
8426     for (iy = 0; iy < my; iy++) {
8427       *phip = xr;
8428       phip  += rowlen;
8429     }
8430   }
8431 
8432 
8433   // Do y dependence.
8434   yp = y;
8435   phip   = phi;
8436   thetap = theta;
8437   statp  = stat;
8438   for (iy = 0; iy < ny; iy++, yp += sxy) {
8439     yr = (*yp + prj->y0)*prj->w[1];
8440 
8441     for (ix = 0; ix < mx; ix++, phip += spt, thetap += spt) {
8442       xr = *phip;
8443 
8444       if (xr <= 0.0 && 0.0 < yr) {
8445         xi1  = -xr - yr;
8446         eta1 =  xr - yr;
8447         *phip = -180.0;
8448       } else if (xr < 0.0 && yr <= 0.0) {
8449         xi1  =  xr - yr;
8450         eta1 =  xr + yr;
8451         *phip = -90.0;
8452       } else if (0.0 <= xr && yr < 0.0) {
8453         xi1  =  xr + yr;
8454         eta1 = -xr + yr;
8455         *phip = 0.0;
8456       } else {
8457         xi1  = -xr + yr;
8458         eta1 = -xr - yr;
8459         *phip = 90.0;
8460       }
8461 
8462       xi  = xi1  + 45.0;
8463       eta = eta1 + 90.0;
8464       abseta = fabs(eta);
8465 
8466       if (abseta <= 90.0) {
8467         if (abseta <= 45.0) {
8468           // Equatorial regime.
8469           *phip  += xi;
8470           *thetap = asind(eta/67.5);
8471           istat = 0;
8472 
8473           // Bounds checking.
8474           if (prj->bounds&2) {
8475             if (45.0+tol < fabs(xi1)) {
8476               istat = 1;
8477               if (!status) status = PRJERR_BAD_PIX_SET("xphx2s");
8478             }
8479           }
8480 
8481           *(statp++) = istat;
8482 
8483         } else {
8484           // Polar regime.
8485           sigma = (90.0 - abseta) / 45.0;
8486 
8487           // Ensure an exact result for points on the boundary.
8488           if (xr == 0.0) {
8489             if (yr <= 0.0) {
8490               *phip = 0.0;
8491             } else {
8492               *phip = 180.0;
8493             }
8494           } else if (yr == 0.0) {
8495             if (xr < 0.0) {
8496               *phip = -90.0;
8497             } else {
8498               *phip =  90.0;
8499             }
8500           } else {
8501             *phip += 45.0 + xi1/sigma;
8502           }
8503 
8504           if (sigma < prj->w[3]) {
8505             *thetap = 90.0 - sigma*prj->w[4];
8506           } else {
8507             *thetap = asind(1.0 - sigma*sigma/3.0);
8508           }
8509           if (eta < 0.0) *thetap = -(*thetap);
8510 
8511           // Bounds checking.
8512           istat = 0;
8513           if (prj->bounds&2) {
8514             if (eta < -45.0 && eta+90.0+tol < fabs(xi1)) {
8515               istat = 1;
8516               if (!status) status = PRJERR_BAD_PIX_SET("xphx2s");
8517             }
8518           }
8519 
8520           *(statp++) = istat;
8521         }
8522 
8523       } else {
8524         // Beyond latitude range.
8525         *phip   = 0.0;
8526         *thetap = 0.0;
8527         *(statp++) = 1;
8528         if (!status) status = PRJERR_BAD_PIX_SET("xphx2s");
8529       }
8530     }
8531   }
8532 
8533 
8534   // Do bounds checking on the native coordinates.
8535   if (prj->bounds&4 && prjbchk(1.0e-12, nx, my, spt, phi, theta, stat)) {
8536     if (!status) status = PRJERR_BAD_PIX_SET("xphx2s");
8537   }
8538 
8539   return status;
8540 }
8541 
8542 //----------------------------------------------------------------------------
8543 
xphs2x(struct prjprm * prj,int nphi,int ntheta,int spt,int sxy,const double phi[],const double theta[],double x[],double y[],int stat[])8544 int xphs2x(
8545   struct prjprm *prj,
8546   int nphi,
8547   int ntheta,
8548   int spt,
8549   int sxy,
8550   const double phi[],
8551   const double theta[],
8552   double x[],
8553   double y[],
8554   int stat[])
8555 
8556 {
8557   int mphi, mtheta, rowlen, rowoff, status;
8558   double abssin, chi, eta, psi, sigma, sinthe, xi;
8559   register int iphi, itheta, *statp;
8560   register const double *phip, *thetap;
8561   register double *xp, *yp;
8562 
8563 
8564   // Initialize.
8565   if (prj == 0x0) return PRJERR_NULL_POINTER;
8566   if (prj->flag != XPH) {
8567     if ((status = xphset(prj))) return status;
8568   }
8569 
8570   if (ntheta > 0) {
8571     mphi   = nphi;
8572     mtheta = ntheta;
8573   } else {
8574     mphi   = 1;
8575     mtheta = 1;
8576     ntheta = nphi;
8577   }
8578 
8579 
8580   // Do phi dependence.
8581   phip = phi;
8582   rowoff = 0;
8583   rowlen = nphi*sxy;
8584   for (iphi = 0; iphi < nphi; iphi++, rowoff += sxy, phip += spt) {
8585     chi = *phip;
8586     if (180.0 <= fabs(chi)) {
8587       chi = fmod(chi, 360.0);
8588       if (chi < -180.0) {
8589         chi += 360.0;
8590       } else if (180.0 <= chi) {
8591         chi -= 360.0;
8592       }
8593     }
8594 
8595     // phi is also recomputed from chi to avoid rounding problems.
8596     chi += 180.0;
8597     psi = fmod(chi, 90.0);
8598 
8599     xp = x + rowoff;
8600     yp = y + rowoff;
8601     for (itheta = 0; itheta < mtheta; itheta++) {
8602       // y[] is used to hold phi (rounded).
8603       *xp = psi;
8604       *yp = chi - 180.0;
8605       xp += rowlen;
8606       yp += rowlen;
8607     }
8608   }
8609 
8610 
8611   // Do theta dependence.
8612   thetap = theta;
8613   xp = x;
8614   yp = y;
8615   statp = stat;
8616   for (itheta = 0; itheta < ntheta; itheta++, thetap += spt) {
8617     sinthe = sind(*thetap);
8618     abssin = fabs(sinthe);
8619 
8620     for (iphi = 0; iphi < mphi; iphi++, xp += sxy, yp += sxy) {
8621       if (abssin <= prj->w[2]) {
8622         // Equatorial regime.
8623         xi  = *xp;
8624         eta = 67.5 * sinthe;
8625 
8626       } else {
8627         // Polar regime.
8628         if (*thetap < prj->w[5]) {
8629           sigma = sqrt(3.0*(1.0 - abssin));
8630         } else {
8631           sigma = (90.0 - *thetap)*prj->w[6];
8632         }
8633 
8634         xi  = 45.0 + (*xp - 45.0)*sigma;
8635         eta = 45.0 * (2.0 - sigma);
8636         if (*thetap < 0.0) eta = -eta;
8637       }
8638 
8639       xi  -= 45.0;
8640       eta -= 90.0;
8641 
8642       // Recall that y[] holds phi.
8643       if (*yp < -90.0) {
8644         *xp = prj->w[0]*(-xi + eta) - prj->x0;
8645         *yp = prj->w[0]*(-xi - eta) - prj->y0;
8646 
8647       } else if (*yp <  0.0) {
8648         *xp = prj->w[0]*(+xi + eta) - prj->x0;
8649         *yp = prj->w[0]*(-xi + eta) - prj->y0;
8650 
8651       } else if (*yp < 90.0) {
8652         *xp = prj->w[0]*( xi - eta) - prj->x0;
8653         *yp = prj->w[0]*( xi + eta) - prj->y0;
8654 
8655       } else {
8656         *xp = prj->w[0]*(-xi - eta) - prj->x0;
8657         *yp = prj->w[0]*( xi - eta) - prj->y0;
8658       }
8659 
8660       *(statp++) = 0;
8661     }
8662   }
8663 
8664   return 0;
8665 }
8666