public software.sextractor

[/] [trunk/] [src/] [wcs/] [wcs.c] - Blame information for rev 235

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 233 bertin
/*
2
*                               wcs.c
3
*
4
* High level driver routines.
5
*
6
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7
*
8
*       This file part of:      AstrOmatic WCS library
9
*
10 235 bertin
*       Copyright:              (C) 2000-2010 Emmanuel Bertin -- IAP/CNRS/UPMC
11
*                               (C) 1995-1999 Mark Calabretta (original version)
12 233 bertin
*
13
*       Licenses:               GNU General Public License
14
*
15
*       AstrOmatic software is free software: you can redistribute it and/or
16
*       modify it under the terms of the GNU General Public License as
17
*       published by the Free Software Foundation, either version 3 of the
18
*       License, or (at your option) any later version.
19
*       AstrOmatic software is distributed in the hope that it will be useful,
20
*       but WITHOUT ANY WARRANTY; without even the implied warranty of
21
*       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22
*       GNU General Public License for more details.
23
*       You should have received a copy of the GNU General Public License
24
*       along with AstrOmatic software.
25
*       If not, see <http://www.gnu.org/licenses/>.
26
*
27
*       Last modified:          10/10/2010
28
*
29
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
30 2 bertin
/*=============================================================================
31
*
32
*   WCSLIB - an implementation of the FITS WCS proposal.
33
*   Copyright (C) 1995-1999, Mark Calabretta
34
*
35
*   This library is free software; you can redistribute it and/or modify it
36
*   under the terms of the GNU Library General Public License as published
37
*   by the Free Software Foundation; either version 2 of the License, or (at
38
*   your option) any later version.
39
*
40
*   This library is distributed in the hope that it will be useful, but
41
*   WITHOUT ANY WARRANTY; without even the implied warranty of
42
*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library
43
*   General Public License for more details.
44
*
45
*   You should have received a copy of the GNU Library General Public License
46
*   along with this library; if not, write to the Free Software Foundation,
47
*   Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
48
*
49
*   Correspondence concerning WCSLIB may be directed to:
50
*      Internet email: mcalabre@atnf.csiro.au
51
*      Postal address: Dr. Mark Calabretta,
52
*                      Australia Telescope National Facility,
53
*                      P.O. Box 76,
54
*                      Epping, NSW, 2121,
55
*                      AUSTRALIA
56
*
57
*=============================================================================
58
*
59
*   C routines which implement the FITS World Coordinate System (WCS)
60
*   convention.
61
*
62
*   Summary of routines
63
*   -------------------
64
*   wcsfwd() and wcsrev() are high level driver routines for the WCS linear
65
*   transformation, spherical coordinate transformation, and spherical
66
*   projection routines.
67
*
68
*   Given either the celestial longitude or latitude plus an element of the
69
*   pixel coordinate a hybrid routine, wcsmix(), iteratively solves for the
70
*   unknown elements.
71
*
72
*   An initialization routine, wcsset(), computes indices from the ctype
73
*   array but need not be called explicitly - see the explanation of
74
*   wcs.flag below.
75
*
76
*
77
*   Initialization routine; wcsset()
78
*   --------------------------------
79
*   Initializes elements of a wcsprm data structure which holds indices into
80
*   the coordinate arrays.  Note that this routine need not be called directly;
81
*   it will be invoked by wcsfwd() and wcsrev() if the "flag" structure member
82
*   is anything other than a predefined magic value.
83
*
84
*   Given:
85
*      naxis    const int
86
*                        Number of image axes.
87
*      ctype[][9]
88
*               const char
89
*                        Coordinate axis types corresponding to the FITS
90
*                        CTYPEn header cards.
91
*
92
*   Returned:
93
*      wcs      wcsprm*  Indices for the celestial coordinates obtained
94
*                        by parsing the ctype[] array (see below).
95
*
96
*   Function return value:
97
*               int      Error status
98
*                           0: Success.
99
*                           1: Inconsistent or unrecognized coordinate axis
100
*                              types.
101
*
102
*
103
*   Forward transformation; wcsfwd()
104
*   --------------------------------
105
*   Compute the pixel coordinate for given world coordinates.
106
*
107
*   Given:
108
*      ctype[][9]
109
*               const char
110
*                        Coordinate axis types corresponding to the FITS
111
*                        CTYPEn header cards.
112
*
113
*   Given or returned:
114
*      wcs      wcsprm*  Indices for the celestial coordinates obtained
115
*                        by parsing the ctype[] array (see below).
116
*
117
*   Given:
118
*      world    const double[]
119
*                        World coordinates.  world[wcs->lng] and
120
*                        world[wcs->lat] are the celestial longitude and
121
*                        latitude, in degrees.
122
*
123
*   Given:
124
*      crval    const double[]
125
*                        Coordinate reference values corresponding to the FITS
126
*                        CRVALn header cards.
127
*
128
*   Given and returned:
129
*      cel      celprm*  Spherical coordinate transformation parameters (usage
130
*                        is described in the prologue to "cel.c").
131
*
132
*   Returned:
133
*      phi,     double*  Longitude and latitude in the native coordinate
134
*      theta             system of the projection, in degrees.
135
*
136
*   Given and returned:
137
*      prj      prjprm*  Projection parameters (usage is described in the
138
*                        prologue to "proj.c").
139
*
140
*   Returned:
141
*      imgcrd   double[] Image coordinate.  imgcrd[wcs->lng] and
142
*                        imgcrd[wcs->lat] are the projected x-, and
143
*                        y-coordinates, in "degrees".  For quadcube
144
*                        projections with a CUBEFACE axis the face number is
145
*                        also returned in imgcrd[wcs->cubeface].
146
*
147
*   Given and returned:
148
*      lin      linprm*  Linear transformation parameters (usage is described
149
*                        in the prologue to "lin.c").
150
*
151
*   Returned:
152
*      pixcrd   double[] Pixel coordinate.
153
*
154
*   Function return value:
155
*               int      Error status
156
*                           0: Success.
157
*                           1: Invalid coordinate transformation parameters.
158
*                           2: Invalid projection parameters.
159
*                           3: Invalid world coordinate.
160
*                           4: Invalid linear transformation parameters.
161
*
162
*
163
*   Reverse transformation; wcsrev()
164
*   --------------------------------
165
*   Compute world coordinates for a given pixel coordinate.
166
*
167
*   Given:
168
*      ctype[][9]
169
*               const char
170
*                        Coordinate axis types corresponding to the FITS
171
*                        CTYPEn header cards.
172
*
173
*   Given or returned:
174
*      wcs      wcsprm*  Indices for the celestial coordinates obtained
175
*                        by parsing the ctype[] array (see below).
176
*
177
*   Given:
178
*      pixcrd   const double[]
179
*                        Pixel coordinate.
180
*
181
*   Given and returned:
182
*      lin      linprm*  Linear transformation parameters (usage is described
183
*                        in the prologue to "lin.c").
184
*
185
*   Returned:
186
*      imgcrd   double[] Image coordinate.  imgcrd[wcs->lng] and
187
*                        imgcrd[wcs->lat] are the projected x-, and
188
*                        y-coordinates, in "degrees".
189
*
190
*   Given and returned:
191
*      prj      prjprm*  Projection parameters (usage is described in the
192
*                        prologue to "proj.c").
193
*
194
*   Returned:
195
*      phi,     double*  Longitude and latitude in the native coordinate
196
*      theta             system of the projection, in degrees.
197
*
198
*   Given:
199
*      crval    const double[]
200
*                        Coordinate reference values corresponding to the FITS
201
*                        CRVALn header cards.
202
*
203
*   Given and returned:
204
*      cel      celprm*  Spherical coordinate transformation parameters
205
*                        (usage is described in the prologue to "cel.c").
206
*
207
*   Returned:
208
*      world    double[] World coordinates.  world[wcs->lng] and
209
*                        world[wcs->lat] are the celestial longitude and
210
*                        latitude, in degrees.
211
*
212
*   Function return value:
213
*               int      Error status
214
*                           0: Success.
215
*                           1: Invalid coordinate transformation parameters.
216
*                           2: Invalid projection parameters.
217
*                           3: Invalid pixel coordinate.
218
*                           4: Invalid linear transformation parameters.
219
*
220
*
221
*   Hybrid transformation; wcsmix()
222
*   -------------------------------
223
*   Given either the celestial longitude or latitude plus an element of the
224
*   pixel coordinate solve for the remaining elements by iterating on the
225
*   unknown celestial coordinate element using wcsfwd().
226
*
227
*   Given:
228
*      ctype[][9]
229
*               const char
230
*                        Coordinate axis types corresponding to the FITS
231
*                        CTYPEn header cards.
232
*
233
*   Given or returned:
234
*      wcs      wcsprm*  Indices for the celestial coordinates obtained
235
*                        by parsing the ctype[] array (see below).
236
*
237
*   Given:
238
*      mixpix   const int
239
*                        Which element of the pixel coordinate is given.
240
*      mixcel   const int
241
*                        Which element of the celestial coordinate is
242
*                        given:
243
*                           1: Celestial longitude is given in
244
*                              world[wcs->lng], latitude returned in
245
*                              world[wcs->lat].
246
*                           2: Celestial latitude is given in
247
*                              world[wcs->lat], longitude returned in
248
*                              world[wcs->lng].
249
*      vspan[2] const double
250
*                        Solution interval for the celestial coordinate, in
251
*                        degrees.
252
*      vstep    const double
253
*                        Step size for solution search, in degrees.  If zero,
254
*                        a sensible, although perhaps non-optimal default will
255
*                        be used.
256
*      viter    int
257
*                        If a solution is not found then the step size will be
258
*                        halved and the search recommenced.  viter controls
259
*                        how many times the step size is halved.  The allowed
260
*                        range is 5 - 10.
261
*
262
*   Given and returned:
263
*      world    double[] World coordinates.  world[wcs->lng] and
264
*                        world[wcs->lat] are the celestial longitude and
265
*                        latitude, in degrees.  Which is given and which
266
*                        returned depends on the value of mixcel.  All other
267
*                        elements are given.
268
*
269
*   Given:
270
*      crval    const double[]
271
*                        Coordinate reference values corresponding to the FITS
272
*                        CRVALn header cards.
273
*
274
*   Given and returned:
275
*      cel      celprm*  Spherical coordinate transformation parameters
276
*                        (usage is described in the prologue to "cel.c").
277
*
278
*   Returned:
279
*      phi,     double*  Longitude and latitude in the native coordinate
280
*      theta             system of the projection, in degrees.
281
*
282
*   Given and returned:
283
*      prj      prjprm*  Projection parameters (usage is described in the
284
*                        prologue to "proj.c").
285
*
286
*   Returned:
287
*      imgcrd   double[] Image coordinate.  imgcrd[wcs->lng] and
288
*                        imgcrd[wcs->lat] are the projected x-, and
289
*                        y-coordinates, in "degrees".
290
*
291
*   Given and returned:
292
*      lin      linprm*  Linear transformation parameters (usage is described
293
*                        in the prologue to "lin.c").
294
*
295
*   Given and returned:
296
*      pixcrd   double[] Pixel coordinate.  The element indicated by mixpix is
297
*                        given and the remaining elements are returned.
298
*
299
*   Function return value:
300
*               int      Error status
301
*                           0: Success.
302
*                           1: Invalid coordinate transformation parameters.
303
*                           2: Invalid projection parameters.
304
*                           3: Coordinate transformation error.
305
*                           4: Invalid linear transformation parameters.
306
*                           5: No solution found in the specified interval.
307
*
308
*
309
*   Notes
310
*   -----
311
*    1) The CTYPEn must in be upper case and there must be 0 or 1 pair of
312
*       matched celestial axis types.  The ctype[][9] should be padded with
313
*       blanks on the right and null-terminated.
314
*
315
*    2) Elements of the crval[] array which correspond to celestial axes are
316
*       ignored, the reference coordinate values in cel->ref[0] and
317
*       cel->ref[1] are the ones used.
318
*
319
*    3) These functions recognize the NCP projection and convert it to the
320
*       equivalent SIN projection.
321
*
322
*    4) The quadcube projections (CSC, QSC, TSC) may be represented in FITS in
323
*       either of two ways:
324
*
325
*          a) The six faces may be laid out in one plane and numbered as
326
*             follows:
327
*
328
*                                       0
329
*
330
*                              4  3  2  1  4  3  2
331
*
332
*                                       5
333
*
334
*             Faces 2, 3 and 4 may appear on one side or the other (or both).
335
*             The forward routines map faces 2, 3 and 4 to the left but the
336
*             inverse routines accept them on either side.
337
*
338
*          b) The "COBE" convention in which the six faces are stored in a
339
*             three-dimensional structure using a "CUBEFACE" axis indexed from
340
*             0 to 5 as above.
341
*
342
*       These routines support both methods; wcsset() determines which is
343
*       being used by the presence or absence of a CUBEFACE axis in ctype[].
344
*       wcsfwd() and wcsrev() translate the CUBEFACE axis representation to
345
*       the single plane representation understood by the lower-level WCSLIB
346
*       projection routines.
347
*
348
*
349
*   WCS indexing parameters
350
*   -----------------------
351
*   The wcsprm struct consists of the following:
352
*
353
*      int flag
354
*         The wcsprm struct contains indexes and other information derived
355
*         from the CTYPEn.  Whenever any of the ctype[] are set or changed
356
*         this flag must be set to zero to signal the initialization routine,
357
*         wcsset() to redetermine the indices.  The flag is set to 999 if
358
*         there is no celestial axis pair in the CTYPEn.
359
*
360
*      char pcode[4]
361
*         The WCS projection code.
362
*
363
*      char lngtyp[5], lattyp[5]
364
*         WCS celestial axis types.
365
*
366
*      int lng,lat
367
*         Indices into the imgcrd[], and world[] arrays as described above.
368
*         These may also serve as indices for the celestial longitude and
369
*         latitude axes in the pixcrd[] array provided that the PC matrix
370
*         does not transpose axes.
371
*
372
*      int cubeface
373
*         Index into the pixcrd[] array for the CUBEFACE axis.  This is
374
*         optionally used for the quadcube projections where each cube face is
375
*         stored on a separate axis.
376
*
377
*
378
*   wcsmix() algorithm
379
*   ------------------
380
*      Initially the specified solution interval is checked to see if it's a
381
*      "crossing" interval.  If it isn't, a search is made for a crossing
382
*      solution by iterating on the unknown celestial coordinate starting at
383
*      the upper limit of the solution interval and decrementing by the
384
*      specified step size.  A crossing is indicated if the trial value of the
385
*      pixel coordinate steps through the value specified.  If a crossing
386
*      interval is found then the solution is determined by a modified form of
387
*      "regula falsi" division of the crossing interval.  If no crossing
388
*      interval was found within the specified solution interval then a search
389
*      is made for a "non-crossing" solution as may arise from a point of
390
*      tangency.  The process is complicated by having to make allowance for
391
*      the discontinuities that occur in all map projections.
392
*
393
*      Once one solution has been determined others may be found by subsequent
394
*      invokations of wcsmix() with suitably restricted solution intervals.
395
*
396
*      Note the circumstance which arises when the solution point lies at a
397
*      native pole of a projection in which the pole is represented as a
398
*      finite curve, for example the zenithals and conics.  In such cases two
399
*      or more valid solutions may exist but WCSMIX only ever returns one.
400
*
401
*      Because of its generality wcsmix() is very compute-intensive.  For
402
*      compute-limited applications more efficient special-case solvers could
403
*      be written for simple projections, for example non-oblique cylindrical
404
*      projections.
405
*
406
*   Author: Mark Calabretta, Australia Telescope National Facility
407
*   $Id: wcs.c,v 1.1.1.1 2002/03/15 16:33:26 bertin Exp $
408
*===========================================================================*/
409
 
410
#ifdef HAVE_CONFIG_H
411
#include        "config.h"
412
#endif
413
 
414
#ifdef HAVE_MATHIMF_H
415
#include <mathimf.h>
416
#else
417
#include <math.h>
418
#endif
419
#include "stdio.h"
420
#include "string.h"
421
#include "wcsmath.h"
422
#include "wcstrig.h"
423
#include "sph.h"
424
#include "wcs.h"
425
 
426
/* Map error number to error message for each function. */
427
const char *wcsset_errmsg[] = {
428
   0,
429
   "Inconsistent or unrecognized coordinate axis types"};
430
 
431
const char *wcsfwd_errmsg[] = {
432
   0,
433
   "Invalid coordinate transformation parameters",
434
   "Invalid projection parameters",
435
   "Invalid world coordinate",
436
   "Invalid linear transformation parameters"};
437
 
438
const char *wcsrev_errmsg[] = {
439
   0,
440
   "Invalid coordinate transformation parameters",
441
   "Invalid projection parameters",
442
   "Invalid pixel coordinate",
443
   "Invalid linear transformation parameters"};
444
 
445
const char *wcsmix_errmsg[] = {
446
   0,
447
   "Invalid coordinate transformation parameters",
448
   "Invalid projection parameters",
449
   "Coordinate transformation error",
450
   "Invalid linear transformation parameters",
451
   "No solution found in the specified interval"};
452
 
453
 
454
#define wcs_signbit(X) ((X) < 0.0 ? 1 : 0)
455
 
456
int wcsset (naxis, ctype, wcs)
457
 
458
const int naxis;
459
const char ctype[][9];
460
struct wcsprm *wcs;
461
 
462
{
463
   int j, k, *ndx;
464
   char requir[9];
465
 
466
   strcpy(wcs->pcode, "");
467
   strcpy(requir, "");
468
   wcs->lng = -1;
469
   ndx = &wcs->lng;     /* to satisfy gcc -Wall */
470
   wcs->lat = -1;
471
   wcs->cubeface = -1;
472
 
473
   for (j = 0; j < naxis; j++) {
474
      if (ctype[j][4] != '-') {
475
         if (strcmp(ctype[j], "CUBEFACE") == 0) {
476
            if (wcs->cubeface == -1) {
477
               wcs->cubeface = j;
478
            } else {
479
               /* Multiple CUBEFACE axes! */
480
               return 1;
481
            }
482
         }
483
         continue;
484
      }
485
 
486
      /* Got an axis qualifier, is it a recognized WCS projection? */
487
      for (k = 0; k < npcode; k++) {
488
         if (strncmp(&ctype[j][5], pcodes[k], 3) == 0) break;
489
      }
490
 
491
      if (k == npcode) {
492
         /* Allow NCP to pass (will be converted to SIN later). */
493
         if (strncmp(&ctype[j][5], "NCP", 3)) continue;
494
      }
495
 
496
      /* Parse the celestial axis type. */
497
      if (strcmp(wcs->pcode, "") == 0) {
498
         sprintf(wcs->pcode, "%.3s", &ctype[j][5]);
499
 
500
         if (strncmp(ctype[j], "RA--", 4) == 0) {
501
            wcs->lng = j;
502
            strcpy(wcs->lngtyp, "RA");
503
            strcpy(wcs->lattyp, "DEC");
504
            ndx = &wcs->lat;
505
            sprintf(requir, "DEC--%s", wcs->pcode);
506
         } else if (strncmp(ctype[j], "DEC-", 4) == 0) {
507
            wcs->lat = j;
508
            strcpy(wcs->lngtyp, "RA");
509
            strcpy(wcs->lattyp, "DEC");
510
            ndx = &wcs->lng;
511
            sprintf(requir, "RA---%s", wcs->pcode);
512
         } else if (strncmp(&ctype[j][1], "LON", 3) == 0) {
513
            wcs->lng = j;
514
            sprintf(wcs->lngtyp, "%cLON", ctype[j][0]);
515
            sprintf(wcs->lattyp, "%cLAT", ctype[j][0]);
516
            ndx = &wcs->lat;
517
            sprintf(requir, "%s-%s", wcs->lattyp, wcs->pcode);
518
         } else if (strncmp(&ctype[j][1], "LAT", 3) == 0) {
519
            wcs->lat = j;
520
            sprintf(wcs->lngtyp, "%cLON", ctype[j][0]);
521
            sprintf(wcs->lattyp, "%cLAT", ctype[j][0]);
522
            ndx = &wcs->lng;
523
            sprintf(requir, "%s-%s", wcs->lngtyp, wcs->pcode);
524
         } else {
525
            /* Unrecognized celestial type. */
526
            return 1;
527
         }
528
      } else {
529
         if (strncmp(ctype[j], requir, 8) != 0) {
530
            /* Inconsistent projection types. */
531
            return 1;
532
         }
533
 
534
         *ndx = j;
535
         strcpy(requir, "");
536
       }
537
     }
538
 
539
   if (strcmp(requir, "")) {
540
      /* Unmatched celestial axis. */
541
      return 1;
542
   }
543
 
544
   if (strcmp(wcs->pcode, "")) {
545
      wcs->flag = WCSSET;
546
   } else {
547
      /* Signal for no celestial axis pair. */
548
      wcs->flag = 999;
549
   }
550
 
551
   return 0;
552
}
553
 
554
/*--------------------------------------------------------------------------*/
555
 
556
int wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, imgcrd, lin,
557
    pixcrd)
558
 
559
const char ctype[][9];
560
struct wcsprm* wcs;
561
const double world[];
562
const double crval[];
563
struct celprm *cel;
564
double *phi, *theta;
565
struct prjprm *prj;
566
double imgcrd[];
567
struct linprm *lin;
568
double pixcrd[];
569
 
570
{
571
   int    err, j;
572
   double offset;
573
 
574
   /* Initialize if required. */
575
   if (wcs->flag != WCSSET) {
576
      if (wcsset(lin->naxis, ctype, wcs)) return 1;
577
   }
578
 
579
   /* Convert to relative physical coordinates. */
580
   for (j = 0; j < lin->naxis; j++) {
581
      if (j == wcs->lng) continue;
582
      if (j == wcs->lat) continue;
583
      imgcrd[j] = world[j] - crval[j];
584
   }
585
 
586
   if (wcs->flag != 999) {
587
      /* Compute projected coordinates. */
588
      if (strcmp(wcs->pcode, "NCP") == 0) {
589
         /* Convert NCP to SIN. */
590
         if (cel->ref[2] == 0.0) {
591
            return 2;
592
         }
593
         strcpy(wcs->pcode, "SIN");
594
         prj->p[1] = 0.0;
595
         prj->p[2] = wcs_cosd(cel->ref[2])/wcs_sind(cel->ref[2]);
596
         prj->flag = 0;
597
      }
598
 
599
      if ((err = celfwd(wcs->pcode, world[wcs->lng], world[wcs->lat], cel,
600
                   phi, theta, prj, &imgcrd[wcs->lng], &imgcrd[wcs->lat]))) {
601
         return err;
602
      }
603
 
604
      /* Do we have a CUBEFACE axis? */
605
      if (wcs->cubeface != -1) {
606
         /* Separation between faces. */
607
         if (prj->r0 == 0.0) {
608
            offset = 90.0;
609
         } else {
610
            offset = prj->r0*PI/2.0;
611
         }
612
 
613
         /* Stack faces in a cube. */
614
         if (imgcrd[wcs->lat] < -0.5*offset) {
615
            imgcrd[wcs->lat] += offset;
616
            imgcrd[wcs->cubeface] = 5.0;
617
         } else if (imgcrd[wcs->lat] > 0.5*offset) {
618
            imgcrd[wcs->lat] -= offset;
619
            imgcrd[wcs->cubeface] = 0.0;
620
         } else if (imgcrd[wcs->lng] > 2.5*offset) {
621
            imgcrd[wcs->lng] -= 3.0*offset;
622
            imgcrd[wcs->cubeface] = 4.0;
623
         } else if (imgcrd[wcs->lng] > 1.5*offset) {
624
            imgcrd[wcs->lng] -= 2.0*offset;
625
            imgcrd[wcs->cubeface] = 3.0;
626
         } else if (imgcrd[wcs->lng] > 0.5*offset) {
627
            imgcrd[wcs->lng] -= offset;
628
            imgcrd[wcs->cubeface] = 2.0;
629
         } else {
630
            imgcrd[wcs->cubeface] = 1.0;
631
         }
632
      }
633
   }
634
 
635
   /* Apply forward linear transformation. */
636
   if (linfwd(imgcrd, lin, pixcrd)) {
637
      return 4;
638
   }
639
 
640
   return 0;
641
}
642
 
643
/*--------------------------------------------------------------------------*/
644
 
645
int wcsrev(ctype, wcs, pixcrd, lin, imgcrd, prj, phi, theta, crval, cel,
646
    world)
647
 
648
const char ctype[][9];
649
struct wcsprm *wcs;
650
const double pixcrd[];
651
struct linprm *lin;
652
double imgcrd[];
653
struct prjprm *prj;
654
double *phi, *theta;
655
const double crval[];
656
struct celprm *cel;
657
double world[];
658
 
659
{
660
   int    err, face, j;
661
   double offset;
662
 
663
   /* Initialize if required. */
664
   if (wcs->flag != WCSSET) {
665
      if (wcsset(lin->naxis, ctype, wcs)) return 1;
666
   }
667
 
668
   /* Apply reverse linear transformation. */
669
   if (linrev(pixcrd, lin, imgcrd)) {
670
      return 4;
671
   }
672
 
673
   /* Convert to world coordinates. */
674
   for (j = 0; j < lin->naxis; j++) {
675
      if (j == wcs->lng) continue;
676
      if (j == wcs->lat) continue;
677
      world[j] = imgcrd[j] + crval[j];
678
   }
679
 
680
 
681
   if (wcs->flag != 999) {
682
      /* Do we have a CUBEFACE axis? */
683
      if (wcs->cubeface != -1) {
684
         face = (int)(imgcrd[wcs->cubeface] + 0.5);
685
         if (fabs(imgcrd[wcs->cubeface]-face) > 1e-10) {
686
            return 3;
687
         }
688
 
689
         /* Separation between faces. */
690
         if (prj->r0 == 0.0) {
691
            offset = 90.0;
692
         } else {
693
            offset = prj->r0*PI/2.0;
694
         }
695
 
696
         /* Lay out faces in a plane. */
697
         switch (face) {
698
         case 0:
699
            imgcrd[wcs->lat] += offset;
700
            break;
701
         case 1:
702
            break;
703
         case 2:
704
            imgcrd[wcs->lng] += offset;
705
            break;
706
         case 3:
707
            imgcrd[wcs->lng] += offset*2;
708
            break;
709
         case 4:
710
            imgcrd[wcs->lng] += offset*3;
711
            break;
712
         case 5:
713
            imgcrd[wcs->lat] -= offset;
714
            break;
715
         default:
716
            return 3;
717
         }
718
      }
719
 
720
      /* Compute celestial coordinates. */
721
      if (strcmp(wcs->pcode, "NCP") == 0) {
722
         /* Convert NCP to SIN. */
723
         if (cel->ref[2] == 0.0) {
724
            return 2;
725
         }
726
 
727
         strcpy(wcs->pcode, "SIN");
728
         prj->p[1] = 0.0;
729
         prj->p[2] = wcs_cosd(cel->ref[2])/wcs_sind(cel->ref[2]);
730
         prj->flag = 0;
731
      }
732
 
733
      if ((err = celrev(wcs->pcode, imgcrd[wcs->lng], imgcrd[wcs->lat], prj,
734
                   phi, theta, cel, &world[wcs->lng], &world[wcs->lat]))) {
735
         return err;
736
      }
737
   }
738
 
739
   return 0;
740
}
741
 
742
/*--------------------------------------------------------------------------*/
743
 
744
int wcsmix(ctype, wcs, mixpix, mixcel, vspan, vstep, viter, world, crval, cel,
745
           phi, theta, prj, imgcrd, lin, pixcrd)
746
 
747
const char ctype[][9];
748
struct wcsprm *wcs;
749
const int mixpix, mixcel;
750
const double vspan[2], vstep;
751
int viter;
752
double world[];
753
const double crval[];
754
struct celprm *cel;
755
double *phi, *theta;
756
struct prjprm *prj;
757
double imgcrd[];
758
struct linprm *lin;
759
double pixcrd[];
760
 
761
{
762
   const int niter = 60;
763
   int    crossed, err, istep, iter, j, k, nstep, retry;
764
   const double tol = 1.0e-10;
765
   double lambda, span[2], step;
766
   double pixmix;
767
   double lng, lng0, lng0m, lng1, lng1m;
768
   double lat, lat0, lat0m, lat1, lat1m;
769
   double d, d0, d0m, d1, d1m, dx;
770
   double dabs, dmin, lmin;
771
   double phi0, phi1;
772
   struct celprm cel0;
773
 
774
   /* Check vspan. */
775
   if (vspan[0] <= vspan[1]) {
776
      span[0] = vspan[0];
777
      span[1] = vspan[1];
778
   } else {
779
      /* Swap them. */
780
      span[0] = vspan[1];
781
      span[1] = vspan[0];
782
   }
783
 
784
   /* Check vstep. */
785
   step = fabs(vstep);
786
   if (step == 0.0) {
787
      step = (span[1] - span[0])/10.0;
788
      if (step > 1.0 || step == 0.0) step = 1.0;
789
   }
790
 
791
   /* Check viter. */
792
   nstep = viter;
793
   if (nstep < 5) {
794
      nstep = 5;
795
   } else if (nstep > 10) {
796
      nstep = 10;
797
   }
798
 
799
   /* Given pixel element. */
800
   pixmix = pixcrd[mixpix];
801
 
802
   dx = 0.0;    /* to satisfy gcc -Wall */
803
   /* Iterate on the step size. */
804
   for (istep = 0; istep <= nstep; istep++) {
805
      if (istep) step /= 2.0;
806
 
807
      /* Iterate on the sky coordinate between the specified range. */
808
      if (mixcel == 1) {
809
         /* Celestial longitude is given. */
810
 
811
         /* Check whether the solution interval is a crossing interval. */
812
         lat0 = span[0];
813
         world[wcs->lat] = lat0;
814
         if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj,
815
                          imgcrd, lin, pixcrd))) {
816
            return err;
817
         }
818
         d0 = pixcrd[mixpix] - pixmix;
819
 
820
         dabs = fabs(d0);
821
         if (dabs < tol) return 0;
822
 
823
         lat1 = span[1];
824
         world[wcs->lat] = lat1;
825
         if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj,
826
                          imgcrd, lin, pixcrd))) {
827
            return err;
828
         }
829
         d1 = pixcrd[mixpix] - pixmix;
830
 
831
         dabs = fabs(d1);
832
         if (dabs < tol) return 0;
833
 
834
         lmin = lat1;
835
         dmin = dabs;
836
 
837
         /* Check for a crossing point. */
838
         if (wcs_signbit(d0) != wcs_signbit(d1)) {
839
            crossed = 1;
840
            dx = d1;
841
         } else {
842
            crossed = 0;
843
            lat0 = span[1];
844
         }
845
 
846
         for (retry = 0; retry < 4; retry++) {
847
            /* Refine the solution interval. */
848
            while (lat0 > span[0]) {
849
               lat0 -= step;
850
               if (lat0 < span[0]) lat0 = span[0];
851
               world[wcs->lat] = lat0;
852
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
853
                                prj, imgcrd, lin, pixcrd))) {
854
                  return err;
855
               }
856
               d0 = pixcrd[mixpix] - pixmix;
857
 
858
               /* Check for a solution. */
859
               dabs = fabs(d0);
860
               if (dabs < tol) return 0;
861
 
862
               /* Record the point of closest approach. */
863
               if (dabs < dmin) {
864
                  lmin = lat0;
865
                  dmin = dabs;
866
               }
867
 
868
               /* Check for a crossing point. */
869
               if (wcs_signbit(d0) != wcs_signbit(d1)) {
870
                  crossed = 2;
871
                  dx = d0;
872
                  break;
873
               }
874
 
875
               /* Advance to the next subinterval. */
876
               lat1 = lat0;
877
               d1 = d0;
878
            }
879
 
880
            if (crossed) {
881
               /* A crossing point was found. */
882
               for (iter = 0; iter < niter; iter++) {
883
                  /* Use regula falsi division of the interval. */
884
                  lambda = d0/(d0-d1);
885
                  if (lambda < 0.1) {
886
                     lambda = 0.1;
887
                  } else if (lambda > 0.9) {
888
                     lambda = 0.9;
889
                  }
890
 
891
                  lat = lat0 + lambda*(lat1 - lat0);
892
                  world[wcs->lat] = lat;
893
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
894
                                   prj, imgcrd, lin, pixcrd))) {
895
                     return err;
896
                  }
897
                  d = pixcrd[mixpix] - pixmix;
898
 
899
                  /* Check for a solution. */
900
                  dabs = fabs(d);
901
                  if (dabs < tol) return 0;
902
 
903
                  /* Record the point of closest approach. */
904
                  if (dabs < dmin) {
905
                     lmin = lat;
906
                     dmin = dabs;
907
                  }
908
 
909
                  if (wcs_signbit(d0) == wcs_signbit(d)) {
910
                     lat0 = lat;
911
                     d0 = d;
912
                  } else {
913
                     lat1 = lat;
914
                     d1 = d;
915
                  }
916
               }
917
 
918
               /* No convergence, must have been a discontinuity. */
919
               if (crossed == 1) lat0 = span[1];
920
               lat1 = lat0;
921
               d1 = dx;
922
               crossed = 0;
923
 
924
            } else {
925
               /* No crossing point; look for a tangent point. */
926
               if (lmin == span[0]) break;
927
               if (lmin == span[1]) break;
928
 
929
               lat = lmin;
930
               lat0 = lat - step;
931
               if (lat0 < span[0]) lat0 = span[0];
932
               lat1 = lat + step;
933
               if (lat1 > span[1]) lat1 = span[1];
934
 
935
               world[wcs->lat] = lat0;
936
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
937
                                prj, imgcrd, lin, pixcrd))) {
938
                  return err;
939
               }
940
               d0 = fabs(pixcrd[mixpix] - pixmix);
941
 
942
               d  = dmin;
943
 
944
               world[wcs->lat] = lat1;
945
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
946
                                prj, imgcrd, lin, pixcrd))) {
947
                  return err;
948
               }
949
               d1 = fabs(pixcrd[mixpix] - pixmix);
950
 
951
               for (iter = 0; iter < niter; iter++) {
952
                  lat0m = (lat0 + lat)/2.0;
953
                  world[wcs->lat] = lat0m;
954
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
955
                                   prj, imgcrd, lin, pixcrd))) {
956
                     return err;
957
                  }
958
                  d0m = fabs(pixcrd[mixpix] - pixmix);
959
 
960
                  if (d0m < tol) return 0;
961
 
962
                  lat1m = (lat1 + lat)/2.0;
963
                  world[wcs->lat] = lat1m;
964
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
965
                                   prj, imgcrd, lin, pixcrd))) {
966
                     return err;
967
                  }
968
                  d1m = fabs(pixcrd[mixpix] - pixmix);
969
 
970
                  if (d1m < tol) return 0;
971
 
972
                  if (d0m < d && d0m <= d1m) {
973
                     lat1 = lat;
974
                     d1   = d;
975
                     lat  = lat0m;
976
                     d    = d0m;
977
                  } else if (d1m < d) {
978
                     lat0 = lat;
979
                     d0   = d;
980
                     lat  = lat1m;
981
                     d    = d1m;
982
                  } else {
983
                     lat0 = lat0m;
984
                     d0   = d0m;
985
                     lat1 = lat1m;
986
                     d1   = d1m;
987
                  }
988
               }
989
            }
990
         }
991
 
992
      } else {
993
         /* Celestial latitude is given. */
994
 
995
         /* Check whether the solution interval is a crossing interval. */
996
         lng0 = span[0];
997
         world[wcs->lng] = lng0;
998
         if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj,
999
                          imgcrd, lin, pixcrd))) {
1000
            return err;
1001
         }
1002
         d0 = pixcrd[mixpix] - pixmix;
1003
 
1004
         dabs = fabs(d0);
1005
         if (dabs < tol) return 0;
1006
 
1007
         lng1 = span[1];
1008
         world[wcs->lng] = lng1;
1009
         if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj,
1010
                          imgcrd, lin, pixcrd))) {
1011
            return err;
1012
         }
1013
         d1 = pixcrd[mixpix] - pixmix;
1014
 
1015
         dabs = fabs(d1);
1016
         if (dabs < tol) return 0;
1017
         lmin = lng1;
1018
         dmin = dabs;
1019
 
1020
         /* Check for a crossing point. */
1021
         if (wcs_signbit(d0) != wcs_signbit(d1)) {
1022
            crossed = 1;
1023
            dx = d1;
1024
         } else {
1025
            crossed = 0;
1026
            lng0 = span[1];
1027
         }
1028
 
1029
         for (retry = 0; retry < 4; retry++) {
1030
            /* Refine the solution interval. */
1031
            while (lng0 > span[0]) {
1032
               lng0 -= step;
1033
               if (lng0 < span[0]) lng0 = span[0];
1034
               world[wcs->lng] = lng0;
1035
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1036
                          prj, imgcrd, lin, pixcrd))) {
1037
                  return err;
1038
               }
1039
               d0 = pixcrd[mixpix] - pixmix;
1040
 
1041
               /* Check for a solution. */
1042
               dabs = fabs(d0);
1043
               if (dabs < tol) return 0;
1044
 
1045
               /* Record the point of closest approach. */
1046
               if (dabs < dmin) {
1047
                  lmin = lng0;
1048
                  dmin = dabs;
1049
               }
1050
 
1051
               /* Check for a crossing point. */
1052
               if (wcs_signbit(d0) != wcs_signbit(d1)) {
1053
                  crossed = 2;
1054
                  dx = d0;
1055
                  break;
1056
               }
1057
 
1058
               /* Advance to the next subinterval. */
1059
               lng1 = lng0;
1060
               d1 = d0;
1061
            }
1062
 
1063
            if (crossed) {
1064
               /* A crossing point was found. */
1065
               for (iter = 0; iter < niter; iter++) {
1066
                  /* Use regula falsi division of the interval. */
1067
                  lambda = d0/(d0-d1);
1068
                  if (lambda < 0.1) {
1069
                     lambda = 0.1;
1070
                  } else if (lambda > 0.9) {
1071
                     lambda = 0.9;
1072
                  }
1073
 
1074
                  lng = lng0 + lambda*(lng1 - lng0);
1075
                  world[wcs->lng] = lng;
1076
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1077
                                   prj, imgcrd, lin, pixcrd))) {
1078
                     return err;
1079
                  }
1080
                  d = pixcrd[mixpix] - pixmix;
1081
 
1082
                  /* Check for a solution. */
1083
                  dabs = fabs(d);
1084
                  if (dabs < tol) return 0;
1085
 
1086
                  /* Record the point of closest approach. */
1087
                  if (dabs < dmin) {
1088
                     lmin = lng;
1089
                     dmin = dabs;
1090
                  }
1091
 
1092
                  if (wcs_signbit(d0) == wcs_signbit(d)) {
1093
                     lng0 = lng;
1094
                     d0 = d;
1095
                  } else {
1096
                     lng1 = lng;
1097
                     d1 = d;
1098
                  }
1099
               }
1100
 
1101
               /* No convergence, must have been a discontinuity. */
1102
               if (crossed == 1) lng0 = span[1];
1103
               lng1 = lng0;
1104
               d1 = dx;
1105
               crossed = 0;
1106
 
1107
            } else {
1108
               /* No crossing point; look for a tangent point. */
1109
               if (lmin == span[0]) break;
1110
               if (lmin == span[1]) break;
1111
 
1112
               lng = lmin;
1113
               lng0 = lng - step;
1114
               if (lng0 < span[0]) lng0 = span[0];
1115
               lng1 = lng + step;
1116
               if (lng1 > span[1]) lng1 = span[1];
1117
 
1118
               world[wcs->lng] = lng0;
1119
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1120
                                prj, imgcrd, lin, pixcrd))) {
1121
                  return err;
1122
               }
1123
               d0 = fabs(pixcrd[mixpix] - pixmix);
1124
 
1125
               d  = dmin;
1126
 
1127
               world[wcs->lng] = lng1;
1128
               if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1129
                                prj, imgcrd, lin, pixcrd))) {
1130
                  return err;
1131
               }
1132
               d1 = fabs(pixcrd[mixpix] - pixmix);
1133
 
1134
               for (iter = 0; iter < niter; iter++) {
1135
                  lng0m = (lng0 + lng)/2.0;
1136
                  world[wcs->lng] = lng0m;
1137
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1138
                                   prj, imgcrd, lin, pixcrd))) {
1139
                     return err;
1140
                  }
1141
                  d0m = fabs(pixcrd[mixpix] - pixmix);
1142
 
1143
                  if (d0m < tol) return 0;
1144
 
1145
                  lng1m = (lng1 + lng)/2.0;
1146
                  world[wcs->lng] = lng1m;
1147
                  if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta,
1148
                                   prj, imgcrd, lin, pixcrd))) {
1149
                     return err;
1150
                  }
1151
                  d1m = fabs(pixcrd[mixpix] - pixmix);
1152
 
1153
                  if (d1m < tol) return 0;
1154
 
1155
                  if (d0m < d && d0m <= d1m) {
1156
                     lng1 = lng;
1157
                     d1   = d;
1158
                     lng  = lng0m;
1159
                     d    = d0m;
1160
                  } else if (d1m < d) {
1161
                     lng0 = lng;
1162
                     d0   = d;
1163
                     lng  = lng1m;
1164
                     d    = d1m;
1165
                  } else {
1166
                     lng0 = lng0m;
1167
                     d0   = d0m;
1168
                     lng1 = lng1m;
1169
                     d1   = d1m;
1170
                  }
1171
               }
1172
            }
1173
         }
1174
      }
1175
   }
1176
 
1177
 
1178
   /* Set cel0 to the unity transformation. */
1179
   cel0.flag = CELSET;
1180
   cel0.ref[0] = cel->ref[0];
1181
   cel0.ref[1] = cel->ref[1];
1182
   cel0.ref[2] = cel->ref[2];
1183
   cel0.ref[3] = cel->ref[3];
1184
   cel0.euler[0] = -90.0;
1185
   cel0.euler[1] =   0.0;
1186
   cel0.euler[2] =  90.0;
1187
   cel0.euler[3] =   1.0;
1188
   cel0.euler[4] =   0.0;
1189
   cel0.prjfwd = cel->prjfwd;
1190
   cel0.prjrev = cel->prjrev;
1191
 
1192
   /* No convergence, check for aberrant behaviour at a native pole. */
1193
   *theta = -90.0;
1194
   for (j = 1; j <= 2; j++) {
1195
      /* Could the celestial coordinate element map to a native pole? */
1196
      *theta = -*theta;
1197
      err = sphrev(0.0, *theta, cel->euler, &lng, &lat);
1198
 
1199
      if (mixcel == 1) {
1200
         if (fabs(fmod(world[wcs->lng]-lng,360.0)) > tol) continue;
1201
         if (lat < span[0]) continue;
1202
         if (lat > span[1]) continue;
1203
         world[wcs->lat] = lat;
1204
      } else {
1205
         if (fabs(world[wcs->lat]-lat) > tol) continue;
1206
         if (lng < span[0]) lng += 360.0;
1207
         if (lng > span[1]) lng -= 360.0;
1208
         if (lng < span[0]) continue;
1209
         if (lng > span[1]) continue;
1210
         world[wcs->lng] = lng;
1211
      }
1212
 
1213
      /* Is there a solution for the given pixel coordinate element? */
1214
      lng = world[wcs->lng];
1215
      lat = world[wcs->lat];
1216
 
1217
      /* Feed native coordinates to wcsfwd() with cel0 set to unity. */
1218
      world[wcs->lng] = -180.0;
1219
      world[wcs->lat] = *theta;
1220
      if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj,
1221
                       imgcrd, lin, pixcrd))) {
1222
         return err;
1223
      }
1224
      d0 = pixcrd[mixpix] - pixmix;
1225
 
1226
      /* Check for a solution. */
1227
      if (fabs(d0) < tol) {
1228
         /* Recall saved world coordinates. */
1229
         world[wcs->lng] = lng;
1230
         world[wcs->lat] = lat;
1231
         return 0;
1232
      }
1233
 
1234
      /* Search for a crossing interval. */
1235
      phi0 = -180.0;
1236
      for (k = -179; k <= 180; k++) {
1237
         phi1 = (float) k;
1238
         world[wcs->lng] = phi1;
1239
         if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj,
1240
                          imgcrd, lin, pixcrd))) {
1241
            return err;
1242
         }
1243
         d1 = pixcrd[mixpix] - pixmix;
1244
 
1245
         /* Check for a solution. */
1246
         dabs = fabs(d1);
1247
         if (dabs < tol) {
1248
            /* Recall saved world coordinates. */
1249
            world[wcs->lng] = lng;
1250
            world[wcs->lat] = lat;
1251
            return 0;
1252
         }
1253
 
1254
         /* Is it a crossing interval? */
1255
         if (wcs_signbit(d0) != wcs_signbit(d1)) break;
1256
 
1257
         phi0 = phi1;
1258
         d0 = d1;
1259
      }
1260
 
1261
      for (iter = 1; iter <= niter; iter++) {
1262
         /* Use regula falsi division of the interval. */
1263
         lambda = d0/(d0-d1);
1264
         if (lambda < 0.1) {
1265
            lambda = 0.1;
1266
         } else if (lambda > 0.9) {
1267
            lambda = 0.9;
1268
         }
1269
 
1270
         world[wcs->lng] = phi0 + lambda*(phi1 - phi0);
1271
         if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj,
1272
                          imgcrd, lin, pixcrd))) {
1273
            return err;
1274
         }
1275
         d = pixcrd[mixpix] - pixmix;
1276
 
1277
         /* Check for a solution. */
1278
         dabs = fabs(d);
1279
         if (dabs < tol) {
1280
            /* Recall saved world coordinates. */
1281
            world[wcs->lng] = lng;
1282
            world[wcs->lat] = lat;
1283
            return 0;
1284
         }
1285
 
1286
         if (wcs_signbit(d0) == wcs_signbit(d)) {
1287
            phi0 = world[wcs->lng];
1288
            d0 = d;
1289
         } else {
1290
            phi1 = world[wcs->lng];
1291
            d1 = d;
1292
         }
1293
      }
1294
   }
1295
 
1296
 
1297
   /* No solution. */
1298
   return 5;
1299
 
1300
}