diff options
Diffstat (limited to 'tksao/wcssubs')
35 files changed, 38628 insertions, 0 deletions
diff --git a/tksao/wcssubs/COPYING b/tksao/wcssubs/COPYING new file mode 100644 index 0000000..6320024 --- /dev/null +++ b/tksao/wcssubs/COPYING @@ -0,0 +1,460 @@ + + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + diff --git a/tksao/wcssubs/Files b/tksao/wcssubs/Files new file mode 100644 index 0000000..94d18da --- /dev/null +++ b/tksao/wcssubs/Files @@ -0,0 +1,179 @@ +WCSTools libwcs Subroutines (3.9.0, March 11, 2011) + +actread.c + Return stars from the USNO ACT Reference Catalog +binread.c + Return stars from catalog files in the TDC binary catalog format +catread.c + Return stars from catalog files in the TDC ASCII catalog format +catutil.c + Subroutines for catalog identification and number range decoding +cel.c + WCSLIB spherical coordinate transformation drivers +daoread.c + Read x, y, and magnitude from DAOFIND output file and return x, y, and + flux for use by IMSTAR or IMWCS. +dateutil.c + Subroutines for conversions between various date and time formats +distort.c + Subroutines for conversions between image pixel and focal plane coordinates +dsspos.c + dsspos() uses the WCS structure to compute sky coordinates given + image pixel X and Y for images with Digitized Sky Survey plate solutions + in their headers. dsspix() uses the WCS structure to compute image + pixel X and Y given sky coordinates for DSS images. Algorithms from + StSCI CASB. +fileutil.c + Subroutines for finding size and contents of ASCII files +findstar.c + findStars() gets the location and brightest pixel of stars in the given + image. Included are subroutines to find and reject bright pixels and + compute a star centroid. +fitsfile.c + FITS header and image reading and writing subroutines, including FITS + table support. +fitswcs.c + GetWCSFITS() returns a WCS structure used by wcs.c subroutines from a FITS + or IRAF .imh image, reading only the header. + GetFITShead() returns a FITS header from a FITS or IRAF .imh image. + DelWCS() delete the WCS keywords in a FITS header. +fortcat.c + Fortran wrapper subroutines for catalog reading subroutines ctgread() and ctgrnum() +fortwcs.c + Fortran wrapper subroutines for all useful subroutines in wcs.c and wcsinit.c +gscread.c + Return HST Guide Stars from standard CDROM format FITS table files for + a given RA, Dec, and magnitude range or list of star numbers. +gsc2read.c + Return GSC II Stars using an HTTP query over the web for + a given RA, Dec, and magnitude range or list of star numbers. +hget.c + Subroutines to extract values from FITS headers by keyword. + Subroutines for parsing RA and Dec strings are included. +hput.c + Subroutines to implant values into FITS headers by keyword (and to + delete headers). +iget.c + Subroutines to extract values from IRAF multi-keyword header parameters +imhfile.c + IRAF header and image reading and writing subroutines. IRAF headers + are converted to FITS headers for use by other programs and can be + derived from FITS headers for writing. +imio.c + Subroutines to get, put, and move pixels of various data types between images + im memory and a program. +imrotate.c + RotFITS() rotates an image by 90, 180, or 270 degrees, with an optional + left-right reflection before the rotation. +imgetwcs.c + GetWCSFITS() reads world coordinate system header information and returns + the image center coordinates and size as well as the wcs data structure. +imsetwcs.c + SetWCSFITS() uses findStars to find the stars in an image, gscread to + find the Guide Stars in the nominal image region, and findRegisration or + findCoords to fit plate-tangent WCS to the image. +lin.c + WCSLIB linear transformation subroutines +matchstar.c + StarMatch() takes a list of reference star positions and a list + of object coordinates from an image and finds the image pixels + which correspond to each of the reference stars. It then uses these + matches to get an image center, plate scale, and rotation. The actual + fit is based on the amoeba subroutine in Numerical Recipes, and all + necessary subroutines are included. +platepos.c + platepos() uses the WCS structure to compute sky coordinates given + image pixel X and Y for images with polynomial plate solutions + in their headers. platepix() uses the WCS structure to compute image + pixel X and Y given sky coordinates for such images. Algorithms are based + on those in dsspos.c, but go straight from pixels to angles without an + intermediate plate coordinate. +poly.c + Polynomial evaluation for SCAMP distortion correction +proj.c + WCSLIB spherical map projection subroutines +sdssread.c + Return Sloan Digital Sky Survey Photometry Catalog sources using an + HTTP query over the web for a given RA, Dec, and magnitude range. +sortstars.c + Subroutines to sort lists of stars by right ascension, magnitude, or flux +sph.c + WCSLIB spherical coordinate transformation subroutines +tabread.c + Return stars from a tab table format catalog file for a given RA, Dec, + and magnitude range or list of star numbers. Based on John Roll's + Starbase format. +tmcread.c + Return 2MASS Point Source Catalog stars from the catalog as ungzipped from + the DVD into (or linked from) a common root directory for a given RA, Dec, + and magnitude range or list of star numbers. Both IDR2 and All-Sky release + formats are supported. +tnxpos.c + tnxpos() uses the WCS keywords set up for IRAF's TNX projection to compute + sky coordinates given image pixel X and Y. tnxpix() uses the WCS structure + to compute image pixel X and Y given sky coordinates for such images. The + projection is a tangent plane with corrections between the rotation and + scaling and the actual projection. +uacread.c + Return USNO A and SA Catalog stars from their standard CDROM format + files for a given RA, Dec, and magnitude range or list of star numbers. +ubcread.c + Return USNO B Catalog stars from their standard format files for a + given RA, Dec, and magnitude range or list of star numbers. +ucacread.c + Return USNO UCAC1, UCAC2, or UCAC3 Catalog stars from their standard format + files for a given RA, Dec, and magnitude range or list of star numbers. +ujcread.c + Return USNO UJ Catalog stars from its standard CDROM format files for + a given RA, Dec, and magnitude range or list of star numbers. +wcs.c + Subroutines for using FITS or IRAF header spatial world coordinate + system information. +wcsinit.c + Subroutines to initialize WCS structure from a FITS header +wcscon.c + Subroutines for converting between B1950, J2000, and galactic + coordinates, mostly based on Starlink SLA_LIB subroutines. +webread.c + Open Starbase files across the Internet using HTTP queries +worldpos.c + worldpos() uses the WCS structure to compute sky coordinates given + image pixel X and Y for images with header information for any of 8 + standard world coordinate systems. worldpix() uses the WCS structure + to compute image pixel X and Y given sky coordinates for the same images. + Mostly from NRAO. +zpxpos.c + zpxpos() uses the WCS keywords set up for IRAF's ZPX projection to + compute sky coordinates given image pixel X and Y. zpxpix() uses + the WCS structure to compute image pixel X and Y given sky coordinates + for such images. The projection is a tangent plane with corrections + between the rotation and scaling and the actual projection. + +fitshead.h + Declarations of FITS header access subroutines +fitsfile.h + Declarations of image access subroutines and FITS table data structure. +imio.h + Declarations of subroutines to convert binary formats of numbers +lwcs.h + Constants used by star-finding and WCS-setting subroutines +wcscat.h + Declarations for star catalog data structures +wcs.h + Declaration of WCS data structure and useful conversions. +wcslib.h + Declarations for WCSLIB high level driver subroutines, trig and inverse + trig functions, spherical map projection subroutines, spherical coordinate + transformation drivers, and linear transformation subroutines + +* Notes: + WCSLIB subroutines were written by Mark Calabretta of CSIRO and have + been modified in several ways: + 1) His distributed wcs.h has been changed to wcslib.h, and + 2) wcstrig.c subroutine names have been changed from <function>d() + to <function>deg() to avoid name conflicts on some operating + systems. + 3) ifndef's at start of headers files have been named to reflect + the names of the header files, i.e. wcslib_h_ in wcslib.h. + 4) All header files have been combined into wcslib.h + 5) Emmanuel Bertin's SCAMP distortion has been added to proj.c:1 diff --git a/tksao/wcssubs/Makefile b/tksao/wcssubs/Makefile new file mode 100644 index 0000000..9caa507 --- /dev/null +++ b/tksao/wcssubs/Makefile @@ -0,0 +1,36 @@ +OBJS = wcsinit.o wcs.o wcscon.o fitsfile.o imhfile.o \ + hget.o hput.o iget.o imio.o worldpos.o platepos.o \ + tnxpos.o zpxpos.o dsspos.o poly.o \ + wcslib.o lin.o cel.o proj.o sph.o wcstrig.o dateutil.o distort.o + +libwcs.a: $(OBJS) + ar rv $@ $? + ranlib $@ + +cel.o: wcslib.h +distort.o: wcs.h fitshead.h wcslib.h +fitsfile.o: fitsfile.h fitshead.h +hget.o: fitshead.h +hput.o: fitshead.h +iget.o: fitshead.h +imhfile.o: fitsfile.h fitshead.h +imio.o: fitshead.h +lin.o: wcslib.h +platepos.o: wcs.h fitshead.h wcslib.h +poly.o: wcslib.h +proj.o: wcslib.h +sph.o: wcslib.h +tnxpos.o: wcs.h fitshead.h wcslib.h +zpxpos.o: wcs.h fitshead.h wcslib.h +wcs.o: wcs.h fitshead.h wcslib.h +wcsinit.o: wcs.h fitshead.h wcslib.h +wcscon.o: wcs.h fitshead.h wcslib.h +wcslib.o: wcslib.h +wcstrig.o: wcslib.h +worldpos.o: wcs.h fitshead.h wcslib.h +dateutil.o: fitsfile.h fitshead.h +fileutil.o: fitsfile.h + +clean: + rm -f *.a *.o + diff --git a/tksao/wcssubs/NEWS b/tksao/wcssubs/NEWS new file mode 100644 index 0000000..963ccc6 --- /dev/null +++ b/tksao/wcssubs/NEWS @@ -0,0 +1,478 @@ +WCSTools WCS subroutine library release history + +Version 3.9.0 (July 25, 2014) +fileutil.c: Add next_line() to return one line of file +fitfile.c: fix buffer reallocation bug in fitsrhead() + +Version 3.8.7 (October 31, 2012) +dateutil.c: Unused l0 dropped from jd2lst(); ts2ss from jd2mst() +imio.c: Fix errors with short and character images in minvec(), maxvec() +wcs.c: Drop d1 and d2 from wcsdist(); diffi from wcsdist1() +wcs.c: Drop depwcs; it's in main wcs structure +wcsinit.c: Drop unused variable iszpx; fix bug in latmin assignment +zpxpos.c: Fix code for quadratic near pole + +catutil.c: Skip trailing right bracket in aget*() + +Version 3.8.6 (August 10, 2012) +All: Update author name +imio.c: Fix 8-bit variables to be unsigned char + +Version 3.8.5 (April 12, 2012) +imio.c: Change 8-bit pixel values from char to unsigned char +fitsfile.c: Always check first 8 characters of FITS files for "SIMPLE" + +Version 3.8.4 (September 1, 2011) +imgetwcs.c, wcsinit.c, wcs.c, wcs.h, worldpos.c: Add TPV WCS for TAN with PV terms + +Version 3.8.3 (May 20, 2011) +hget.c: Free allocated memory in strnsrch() to eliminate memory leak (2011-05-19) +imhfile.c: Free *newpixname* not pixname. (2011-05-20) +wcsinit.c: Change error() calls to setwcserr() +wcslib.h: Declare undeclared SCAMP subroutine raw-to-pv() +wcs.c: Fix wcsfree() so it frees depended-on WCS structures (2011-05-09) + +March 18, 2011 - Release 3.8.2 +zpxpos.c, wcs.c, wcsinit.c: Add support for NOAO ZPX protection (Frank Valdes) +imsetwcs.c: Allocate NMAXMAG instead of number of magnitudes, nmag +wcsinit.c,wcs.c,proj.c: Support SCAMP TAN distortion correction (Ed Los) +wcsinit.c: ARSEC and DEG constants used by SCAMP replaced by S2D and D2S +proj.c: If no PV coefficients in ZPN projection, make it ARC +wcs.c: Fix bug involving dependent WCS's (Ed Los) + +April 30, 2010 - Release 3.8.1 +scat,imcat: Set GSC2 magnitudes > 90 to 99.99 +gethead: Fix buffer reallocation bug which crashed reading very large + headers +gethead: Fix trailing spaces on ASCII file quoted string values +gethead: Fix problems with string value extraction changing ASCII files +skycoor: Use number of decimal places from -n for -r difference if set +wcscon.c: Fix bug in fk524() e-term computation; fix J<->B conversions +fitsfile.c: In fitswhead(), always pad blocks to 2880 bytes with spaces + and fix bug dealing with large primary headers +wcscon.c: Fix bug in computing the magnitude of the e-terms in fk524() + and drop ep1 assignment after line 178 in wcsconp() + + +November 13, 2009 - Release 3.8.0 +dateutil.c: Fix possible bug in nutation subroutine +fitsfile.c: Add subroutine moveb() and fix binary table calls to it + Fix lengths for ASCII numeric table entries in fitsrthead() +fitsfile.h: Add moveb() which is used by binary FITS table code in fitsfile.c +hget.c: In strfix(), if parentheses enclose a number, drop them + +November 21, 2008 - Release 3.7.6 +fitsfile.c: In fitswhead() do not print write error if nw = nbytes +dateutil.c: Use IAU 2006 nutation for sidereal time computations +dateutil.c: Add ang2hr(), ang2deg(), deg2ang(), and ang2hr() to + convert betweem decimal floating point degrees and + vigesimal hours or degrees +tnxpos.c: Fix image to world coordinate system transformation and + WCS to image transformation + +July 1, 2008 - Release 3.7.5 +wcsinit.c: Initialize TNX projection when projection types first set and + check for IMAGEW and IMAGEH if NAXIS1 and NAXIS2 not present, +fitsfile.c: Drop comma from name when reading file in isfits() and + do not append primary data header if it is the only header + +May 9, 2008 - Release 3.7.4 +fitsfile.c: In isfits(), allow extensions in FITS files without .fit or .fts +wcsinit.c: Call tnxinit() before any projection calls are made + +March 20, 2008 - Release 3.7.3 +wcs.c: Compute angular separation in wcsdist() using arcos + +December 31, 2007 - Release 3.7.2 +wcscon.c: In wcsconp, make it clear that proper motion is in spherical coordinates +fitsfile.c: Add support to BINTABLE in ftget*() and fitsrthead() +fitsfile.c: Add data heap numerated by PCOUNT when skipping HDU in fitsrhead() +fitsfile.c: Return NULL pointer if fitsrhead() cannot find requested HDU +fitswcs.c: Print error message set by fitsrhead() + +November 9, 2007 - Release 3.7.1 +wcsinit.c: Fix bug which tested &mchar instead of mchar in if statement + +August 24, 2007 - Release 3.7.0 +hget.c: If a closing quote isn't found in a string value, make one up +hput.c: Fix bug in comment insertion and deal correctly with missing quotes + +June 11, 2007 - Release 3.6.9 +imio.c: Add minvec() and speed up maxvec() + +April 3, 2007 - Release 3.6.8 +hget.c: Initial header length to zero in hlength() if lhead argument <= 0 +wcs.c: In wcstype(), set to WCS_PIX if CTYPEi starts with "DET" +wcs.c: In wcspset(), use correct cdelts when converting PC matrix to CD matrix +wcsinit.c: Fix bug so RA, DEC, SECPIX can be used to set a WCS +tnxpos.c: Fix bug so it doesn't crash + +January 16, 2007 - Release 3.6.7 +wcs.h: Fix and add ANSI C prototypes +imio.h: Drop as it has been included in fitsfile.h for several releases now +fitsfile.h, fitshead.h: Add ANSI C prototypes +wcsinitc(),wcsninitc(),hgeti4c(),hgetr8c(),hgetsc(): Change WCS letter argument + from char to char* +hget.c: Declare header and keyword const char in most subroutines +hput.c: Declare keyword and value const in most subroutines +hput.c: Fix bug in ra2str() and dec2str() so ndec=0 works +imio.c: Include fitsfile.h instead of imio.h +wcslib.h: Drop semicolon at end of c++ ifdef +wcslib.h: Drop second declaration of SZP subroutines + +November 2, 2006 - Release 3.6.6 +fitsfile.c: Use calloc() when reallocating header as it is read +wcsinit.c: Limit naxes to 2 everywhere; RA and DEC should always be 1st +wcsinit.c: If either CUNITi is "pixel" set projection to WCS_XY +wcscon.c: In wcscsys, set system to WCS_XY if PIXEL projection +wcscon.c: In wcscsys, set system to WCS_LINEAR if LINEAR coordinate system +dateutil.c, fitshead.h: Add sidereal time to UT and vice versa + +June 30, 2006 - Release 3.6.5 +wcsinit.c: Deal with up to 9x9 PC matrix +wcs.c: Limit WCSLIB dimensions to two (this will change in 4.0) +hput.c: Fix comment placement and replacement +hget.c: Add strfix(), a utility to clean up strings + +May 3, 2006 - Release 3.6.4 +fileutil.c: Add istiff(), isjpeg(), isgif() to check TIFF, JPEG, GIF files +fitsfile.c: Add fitsrtail() to read appended FITS headers +fitsfile.c: Add file name to header-reading error messages +fitswcs.c: Add code to read FITS header appended to TIFF file +imio.c: Fix bug of occasional double application of bscale in getvec() + Clean up arithmetic and increment in addpix() and multpix() +imsetwcs.c: Allow number of decimal places in image coordinates to be set +wcsinit.c: Get Epoch of observation from MJD-OBS or DATE-OBS/UT unless DSS +wcsinit.c: Set wcs->naxes to actual number of image WCS axes, usually 2 +wcscon.c,dateutil.c,fitsfile.c: Drop declarations of unused variables +wcs.c: Fix calls to avoid type conflicts in Linux + + +January 5, 2006 - Release 3.6.3 +wcs.h: Add WCS_ICRS to list of coordinate systems +wcsinit.c: Initialize sys to WCS_ICRS if appropriate +wcscon.c: Avoid precesssing ICRS coordinates +wcscon.c: Fix precession which broke in 3.6.1 + +July 21, 2005 - Release 3.6.2 +wcs.c: Fix wcsrange() to return correct range around RA=0 +Clean up accumulated unused and misdeclared variables using lint + +April 13, 2005 - Release 3.6.1 +Remove all sla_lib subroutines and calls thereto from wcscon.c, replacing +them with local code. + +March 17, 2005 - Release 3.6.0 +In wcs.c, fix bug in wcsrotset() so angles > 360 are set to angle - 360, not 360 +Use unbuffered read() in isfits() in fitsfile.c + +------------------------ + +November 01, 2004 - Release 3.5.8 +In wcs.c, keep wcs->rot between 0 and 360 degrees (360.0 -> 0.0) + +September 21, 2004 - Release 3.5.7 +In pix2wcs(), if spherical coordinate output, keep 0 < long/RA < 360 +Fix bug in wcsfull() when wrapping around RA=0:00 +In hput.c, add fixnegzero() to avoid putting -0.000 in header + +September 3, 2004 - Release 3.5.6 +Modify FITS file reading software to get image size from file size if +SIMPLE is F, so FITS headers with WCS can be used on arbitrary files. +In hget.c, fix bug so comment is not pushed onto the next line if character +value string lengthens (off by one bug). + +July 13, 2004 - Release 3.5.5 +Add headshrink to hput.c to optionally keep blank lines after +keywords are deleted. +Read D, d, E, and e as exponent delimiters in floating point values in hget.c + + +May 6, 2004 - Release 3.5.4 +Add fitswexhead() to fitsfile.c to overwrite FITS extension headers + +April 16, 2004 - Release 3.5.3 +Use strncsrch() in hget.c to get differently-cased keywords. + +February 3, 2004 - Release 3.5.2 +In worldpix() in worldpos.c, allow ra/long. to exceed 180 if reference +pixel is more than 180 degrees from image (1,1). + +December 12, 2003 - Release 3.5.1 +Change p[0,1,2] initializations to p[1,2,3] in wcsinit.c to match proj.c +(This affects constants for AZP,SIN,COP,COE,COD,COO,SZP,CEA,CYP,AIR,BON) +Add wcs->naxes back into wcs structure for backward compatibility; it +should always be equal to wcs->naxis. +Fix bug in numdec() to return 0 if no digits after decimal point +Fix call to setwcserr() with format in it + +November 17, 2003 - Release 3.5.0 +Rename mgets() to mgetstr() in iget.c, wcsinit.c and fitshead.h +Add numdec() to hget.c to return number of decimal places in numeric string +Change wcs->naxes to wcs->naxis to prepare for WCSLIB 3.* +In iraf2fits() and irafrimage(), use image, not physical, dimensions. +In iraf2fits(), set NAXISi to image dimensions, NPAXISi to physical dimensions. +Fix bugs in wcsfull() in wcs.c +Move all distortion-related code to distort.c; include unistd.h +Include stdlib.h instead of malloc.h in lin.c and drop malloc.h from matchstar.c + +------------------------ + +August 22, 2003 - Release 3.4.2 +Add fitsrfull() subroutine to read FITS files with more than 2 dimensions +Modify fitswimage() to write FITS files with more than 2 dimensions + +July 11, 2003 - Release 3.4.1 +Use strncmp to check for both stdin and stdout in fitsfile.c + +May 30, 2003 - Release 3.4.0 +Add partial support for ZPX projection +Fix bug reading COE and other projections when PROJPn coefficients +were accidently reinitialized + +------------------------ + +May 8, 2003 - Release 3.3.4 +Add two missing semicolons in C++ declarations in wcs.h +Read prj.p[0] from PROJP0 for ZPN projections, instead of ignoring it + +April 3, 2003 - Release 3.3.2 +Add distortion conversion for SIRTF images + +March 27, 2003 - Release 3.3.1 +Add conversions to and from Heliocentric Julian Dates to dateutil.c +Open FITS and IMH files "rb" instead of "r" for Linux compatibility +Add isimlistd() to fileutil.c to check for list of images in a specified directory +Fix default center pixel computation in GetFITSWCS(); it was off by half a pixel + +January 30, 2003 - Release 3.3.0 +Fix bug in dateutil.c ts2gst() sidereal time conversion. + +------------------------ + +January 3, 2003 - Release 3.2.1 +Fix bug in wcsinit() which failed to read PVi_0, and now initialize +PVi_j in only once place. + +December 6, 2002 - Release 3.2.0 +Add ET/TDT/TT and sidereal time conversion to dateutil.c +Fix subroutine calls for radvel and latpole and correctly compute pixel +at center of image for default CRPIX in wcsinit.c +Add fitsrsect() to fitsfile.c to read a section of an image + +------------------------ + +August 30, 2002 - Release 3.1.3 +Fix bug in imio.c getvec() dealing with scaled images +Add case-insensitive string search subroutines strcsrch() and strncsrch() +Accept stdin as file in isfile() +Add Ephemeris time conversions to dateutil() + +July 8, 2002 - Release 3.1.2 +Fix bug in date utilities which always rounded to integer seconds of UT +Fix bugs in date utilities to handle BC (negative) dates to JD 0. + +June 26, 2002 - Release 3.1.1 +Fix bugs which caused TNX projection to fail +Fix two bugs in wcsinit() which caused setting RADECSYS when + an EQUINOX keyword is present. +Write FITS error messages to string accessible by fitserr() +Put SAO-written software under Gnu Lesser Public License + +April 12, 2002 - Release 3.1.0 +Implement WCSLIB 2.9 +Support PV entry of constants and PCi_j rotation matrices in wcsinit.c +Support inversion (WCS->pix) of multiple dependent WCSs +Add hgetri4c(), hgetr8c(), and hgetsc() for multiple WCS handling +Fix bug in TNX projection software which caused an infinite loop during +coefficient parsing. + +------------------------ + +February 13, 2002 - Release 3.0.7 +Fix bug in ecliptic coordinate conversion in wcscon.c +Allow "stdin" to include extension and/or WCS selection in fitsfile.c +Add a global switch to turn off scaling in imio.c +Add ifdef to lin.c so it will compile under Mac OS/X + +December 4, 2001 - Release 3.0.6 +In movepix(), add char to char move +Always include stdlib.h in lin.c + +September 25, 2001 - Release 3.0.5 +Implement WCSLIB version 2.7 +Fix Makefile to include header files appropriately +Accept FITS dates as yyyy/mm/dd +Fix bug in str2dec() which misinterpreting strings with leading spaces +Fix bug in isnum() which caused bad answer if trailing spaces +Add fileutil.c, which includes various file info utilities + +September 7, 2001 - Release 3.0.3 +Disallow files with = in their name in isfits() and isiraf() +Set coordinate system from CTYPE if not equatorial + +July 12, 2001 - Release 3.0 +Read PROJPn projection constants in wcsinit() + +------------------------ + +March 30, 2001 - Release 2.9.4 +Fix possible header length problem in hget.c + +March 22, 2001 - Release 2.9.3 +Fix minor bugs in wcs.h, wcs.c, and wcsinit.c, wcslib.c, fitsfile.c, and +cel.c found by gcc on Linux and possible memory leak in wcs.c + +March 9, 2001 - Release 2.9.2 +In fitsfile.c, change multiple WCS separator in FITS file names from : to % +and fix bug which failed to read multi-extension files if END was not preceded +by a blank line in the extension's header. + +February 28, 2001 - Release 2.9.1 +Fix major bug in wcsinit() which always set CRPIX2 the same as CRPIX1 + +February 23, 2001 - Release 2.9.0 +FITS reading subroutines are fixed to ignore WCS name or character specified +as :name or :character at end of filename. +wcsinit() has new APIs which specify either a WCSNAME, wcsinitn(), or +a WCS character, wcsinitc(), to allow use of multiple WCS's in a single +FITS header. The WCSDEPx keyword has been added to indicate dependence +on another WCS, though this feature has not been thoroughly debugged. +fitscimage() is fixed so it doesn't overwrite data when overwriting a file +An off-by-one bug was fixed for some polynomial types in tnxpos(). +The WCSLIB subroutines were brought up to release 2.6 with very minor changes + +------------------------ + +December 29, 2000 - Release 2.8.6 +Fix handling of embedded + or - in isnum() in hget.c +Default to 2000 for EQUINOX and EPOCH and FK5 for RADECSYS, if keywords not present. +In wcscon.c, fk425() and fk524() algorithms were updated to include parallax and rv, +proper motion is added by wcscon*() after fk425() or fk524() from system epoch, and +proper motion units in fk524p() and fk425p() were fixed. +In wcsinit.c, a bug initializing CD matrix was fixed. +In cel.c, include string.h for strcmp(). + +September 29, 2000 - Release 2.8.5 +wcsinit will now use a CD matrix if ANY CD keywords are present in header +In getvec() in imio.c, move scaling outside of loop and make it conditional. +Read .pix files in same directory as .imh file, if not otherwise found. + +August 1, 2000 - Release 2.8.3 +Improve handling of 1-D WCS data. Fix numerous warning-generating bugs. +Fix bug in ep2jd()/jd2ep() so both start year at 1/1 0:00 + +June 13, 2000 - Release 2.8.2 +If imh pixel file has no directory, *always* use same as header file + +June 9, 2000 - Release 2.8.1 +Read keyword values in hget.c even if no equal sign is present. + +June 2, 2000 - Release 2.8.0 +Only a few minor changes due to running lint on everything + +------------------------ + +May 10, 2000 - Release 2.7.4 +In wcstype(), default to WCS_LIN, not error (after Bill Joye) + +May 1, 2000 - Release 2.7.3 +Bug in hadd() fixed so new line is not overwritten. +Pixel files whcih are in subdirectories of files where IRAF .imh header +files reside are now dealt with correctly. +All dates in the old FITS format (dd/mm/yy) where the year ranges from + 0 to 999 have 1900 added to them: 01/05/100 becomes 2000-05-01. + +March 27, 2000 - Release 2.7.2 +In hputs(), do not add quotes if writing COMMENT or HISTORY +In fits2iraf(), in imhfile.c, minimize length of path in pixel file name +Fix code to deal with .imh file paths longer than 67 characters. +In platepix(), use inverse CD matrix to get better initial x,y value +Change the maximum header string length in the hget header reading + subroutines from 57600 to 256000 +Replace oldsys with wcsproj in the WCS data structure so that more options + are available, such as forcing use of AIPS or WCSLIB projection subroutines +Add setdatedec() to set the number of decimal places in FITS date strings + returned by dateutil subroutines +Fix precession code to deal correctly with equinoxes other than J2000 and + B1950. +Move all date operations to dateutil.c, including current time used in imhfile.c + +February 23, 2000 - Release 2.7.0 +Upgrade WCSLIB subroutines to WCSLIB 2.5 from 2.4 +Add MJD and Besselian and Julian epoch conversion to dateutil.c +Use WCSLIB CAR, COE, NCP projections if oldsys is 1, else use worldpos() +Set CD matrix when using DSS projection +Change oldwcs in wcs.h from switch to multi-value flag wcsproj, default is same +Fix minor bug in fitsfile.c fitscimage error returns. + +------------------------ + +January 11, 2000 - Release 2.6.12 +Fix bug in dateutil() to get fractional year to date conversion right + +December 20, 1999 - Release 2.6.11 +Fix bug in hgetdate() to get ISO minutes and seconds right +Upgrade dateutil() to do many date conversions + +December 10, 1999 - Release 2.6.10 +Fix bug which caused strings starting with d and e followed by numbers +to be declared numeric even though they're not really numbers +Fix bug in dateutil.c ts2jd() which does not affect SAOimage +Fix bugs dealing with NOAO TNX projection + +November 17, 1999 - Release 2.6.9 +Fix bug which caused loss of NCP projection + +November 5, 1999 - Release 2.6.8 +Change release number to match WCSTools +Clean up code in all subroutines using lint +Add DATE-MOD to FITS header in iraf2fits() +Added dateutil.c file for conversions between date formats (used by iraf2fits()) +Return error code from hput*() subroutines if header buffer length exceeded. + +------------------------ + +May 5, 1999 - Release 1.26 +hget.c, iget.c Use POSIX-compliant limits.h instead of values.h + +April 7, 1999 - Release 1.26 +wcs.c Fix bug in dealing with EPOCHless non-equatorial coordinates +wcsinit.c Add optional filename to printed error messages + +April 5, 1999 - Release 1.26 +hget.c Check all string lengths before copying; ignore ^M at 80th character + +February 22, 1999 - Release 1.26 +wcs.c Fix bug dealing with SPA and NPA coordinates + Use faaces 0-5, not 1-6 for quad cube projections +wcsinit.c Fix computed rotation angle for DSS projection + +February 9, 1999 - Release 1.26 +fitsfile.c: Allow BITPIX=0 dataless images +wcsinit.c: Fix bug initializing DSS image rotation +wcs.c: Free lin.imgpix and lin.piximg in wcsfree() +hput.c: Fix bug to avoid writing HISTORY or COMMENT lines past 80 chars + +------------------------ + +December 8, 1998 - Release 1.25 +fitsfile.c: Fix bug in fitsrhead() reading FITS table files caused by fix below + +November 30, 1998 - Release 1.25 +fitsfile.c: Fix bug dealing with very large headers in fitsrhead() + +November 12, 1998 - Release 1.25 +dsspos.c: Fix possible divide by zero problems +fitsfile.c: Add isfits() which checks filename or first line of header +imhfile.c: Add isiraf() which checks filename for .imh +hget.c: Assume 2-digit year in hyphen-separated date means FITS, not ISO +tnxpos.c: Fix multiple bugs +wcscon.c: Add wcscstr() to get coordinate system as a character string +wcscon.c: Add subroutine wcsconp() to convert coordinates + proper motions +wcs.c: Add North and South Polar Angle coordinate systems +wcs.c: Build WCS command initialization by getenv() into wcs*init() +wcs.c: Fix bug in wcssize(); fix bug with rotated mirrored images +wcslib.h: Add cel.h, lin.h, proj.h, and wcstrig.h to wcslib.h +worldpos.c: Fix bug in inverse (sky to pixel) COE projection +cel.c, lin.c, proj.c, sph.c, wcstrig.c: Include only wcslib.h diff --git a/tksao/wcssubs/Readme b/tksao/wcssubs/Readme new file mode 100644 index 0000000..61107cf --- /dev/null +++ b/tksao/wcssubs/Readme @@ -0,0 +1,36 @@ +WCSsubs Subroutines + +These subroutines, developed as part of the WCSTools software package, +constitute a self-contained package for accessing the world coordinate +systems of FITS or IRAF(.imh) images, with image header I/O contained +in fitsfile.c and imhfile.c, and WCS initialization and use through the +subroutines in wcs.c. WCS information for an image is kept in a single +data structure defined in wcs.h. Pixel to WCS translations are done by +calls to pix2wcst() or pix2wcs(). WCS to pixel translations are done +by calls to wcs2pix() or wcsc2pix(). The contents of the files are +briefly described in Files. Dependencies between these files are given +in Makefile. Documentation, to some extent, is online at + +http://tdc-www.harvard.edu/software/wcstools/libwcs.wcs.html + +Documentation for the entire open-source WCSTools package is online at + +http://tdc-www.harvard.edu/software/wcstools/ + +Projection code in wcspos.c is by Bill Cotton of NRAO and is +protected by the Gnu Lesser General Public License, which is stated +in the file COPYING. Projection code in wcslib.c, +cel.c, lin.c, proj.c, wcstrig.c, and sph.c is by Mark Calabretta +of CSIRO and is also protected by the Gnu Lesser General Public +License. Code in slasubs.c is by Pat Wallace of the Starlink +project at Cambridge University. Doug Mink is responsible for +the rest of the code, unless otherwise noted in the source file. +Unless otherwise noted, this code is Copyright 2003 by the +Smithsonian Astrophysical Observatory and protected by the Gnu +Lesser General Public License. + +-Jessica Mink (jmink@cfa.harvard.edu) + Telescope Data Center + Harvard-Smithsonian Center for Astrophysics + Cambridge, Massachusetts + http://tdc-www.harvard.edu/mink diff --git a/tksao/wcssubs/cel.c b/tksao/wcssubs/cel.c new file mode 100644 index 0000000..744bb5f --- /dev/null +++ b/tksao/wcssubs/cel.c @@ -0,0 +1,474 @@ +/*============================================================================= +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* C routines which implement the FITS World Coordinate System (WCS) +* convention. +* +* Summary of routines +* ------------------- +* These routines are provided as drivers for the lower level spherical +* coordinate transformation and projection routines. There are separate +* driver routines for the forward, celfwd(), and reverse, celrev(), +* transformations. +* +* An initialization routine, celset(), computes intermediate values from +* the transformation parameters but need not be called explicitly - see the +* explanation of cel.flag below. +* +* +* Initialization routine; celset() +* -------------------------------- +* Initializes members of a celprm data structure which hold intermediate +* values. Note that this routine need not be called directly; it will be +* invoked by celfwd() and celrev() if the "flag" structure member is +* anything other than a predefined magic value. +* +* Given: +* pcode[4] const char +* WCS projection code (see below). +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters +* (see below). +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Ill-conditioned coordinate transformation +* parameters. +* +* Forward transformation; celfwd() +* -------------------------------- +* Compute (x,y) coordinates in the plane of projection from celestial +* coordinates (lng,lat). +* +* Given: +* pcode[4] const char +* WCS projection code (see below). +* lng,lat const double +* Celestial longitude and latitude of the projected +* point, in degrees. +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters +* (see below). +* +* Returned: +* phi, double* Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Given and returned: +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Returned: +* x,y double* Projected coordinates, "degrees". +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Invalid projection parameters. +* 3: Invalid value of (lng,lat). +* +* Reverse transformation; celrev() +* -------------------------------- +* Compute the celestial coordinates (lng,lat) of the point with projected +* coordinates (x,y). +* +* Given: +* pcode[4] const char +* WCS projection code (see below). +* x,y const double +* Projected coordinates, "degrees". +* +* Given and returned: +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Returned: +* phi, double* Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters +* (see below). +* +* Returned: +* lng,lat double* Celestial longitude and latitude of the projected +* point, in degrees. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Invalid projection parameters. +* 3: Invalid value of (x,y). +* +* Coordinate transformation parameters +* ------------------------------------ +* The celprm struct consists of the following: +* +* int flag +* The celprm struct contains pointers to the forward and reverse +* projection routines as well as intermediaries computed from the +* reference coordinates (see below). Whenever the projection code +* (pcode) or any of ref[4] are set or changed then this flag must be +* set to zero to signal the initialization routine, celset(), to +* redetermine the function pointers and recompute intermediaries. +* Once this has been done pcode itself is ignored. +* +* double ref[4] +* The first pair of values should be set to the celestial longitude +* and latitude (usually right ascension and declination) of the +* reference point of the projection. These are given by the CRVALn +* keywords in FITS. +* +* The second pair of values are the native longitude of the celestial +* pole and the celestial latitude of the native pole and correspond to +* FITS keywords LONPOLE and LATPOLE. +* +* LONPOLE defaults to 0 degrees if the celestial latitude of the +* reference point of the projection is greater than the native +* latitude, otherwise 180 degrees. (This is the condition for the +* celestial latitude to increase in the same direction as the native +* latitude at the reference point.) ref[2] may be set to 999.0 to +* indicate that the correct default should be substituted. +* +* In some circumstances the celestial latitude of the native pole may +* be determined by the first three values only to within a sign and +* LATPOLE is used to choose between the two solutions. LATPOLE is +* set in ref[3] and the solution closest to this value is used to +* reset ref[3]. It is therefore legitimate, for example, to set +* ref[3] to 999.0 to choose the more northerly solution - the default +* if the LATPOLE card is omitted from the FITS header. For the +* special case where the reference point of the projection is at +* native latitude zero, its celestial latitude is zero, and +* LONPOLE = +/- 90 then the celestial latitude of the pole is not +* determined by the first three reference values and LATPOLE +* specifies it completely. +* +* The remaining members of the celprm struct are maintained by the +* initialization routines and should not be modified. This is done for the +* sake of efficiency and to allow an arbitrary number of contexts to be +* maintained simultaneously. +* +* double euler[5] +* Euler angles and associated intermediaries derived from the +* coordinate reference values. +* +* +* WCS projection codes +* -------------------- +* Zenithals/azimuthals: +* AZP: zenithal/azimuthal perspective +* TAN: gnomonic +* STG: stereographic +* SIN: synthesis (generalized orthographic) +* ARC: zenithal/azimuthal equidistant +* ZPN: zenithal/azimuthal polynomial +* ZEA: zenithal/azimuthal equal area +* AIR: Airy +* +* Cylindricals: +* CYP: cylindrical perspective +* CEA: cylindrical equal area +* CAR: Cartesian +* MER: Mercator +* +* Pseudo-cylindricals: +* SFL: Sanson-Flamsteed +* PAR: parabolic +* MOL: Mollweide +* +* Conventional: +* AIT: Hammer-Aitoff +* +* Conics: +* COP: conic perspective +* COD: conic equidistant +* COE: conic equal area +* COO: conic orthomorphic +* +* Polyconics: +* BON: Bonne +* PCO: polyconic +* +* Quad-cubes: +* TSC: tangential spherical cube +* CSC: COBE quadrilateralized spherical cube +* QSC: quadrilateralized spherical cube +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: cel.c,v 1.1.1.1 2016/03/30 20:00:02 joye Exp $ +*===========================================================================*/ + +#include <math.h> +#include <string.h> +#include "wcslib.h" + +/* Map error number to error message for each function. */ +const char *celset_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Ill-conditioned coordinate transformation parameters"}; + +const char *celfwd_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Invalid projection parameters", + "Invalid value of (lng,lat)"}; + +const char *celrev_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Invalid projection parameters", + "Invalid value of (x,y)"}; + + +int +celset(pcode, cel, prj) + +const char pcode[4]; +struct celprm *cel; +struct prjprm *prj; + +{ + int dophip; + const double tol = 1.0e-10; + double clat0, cphip, cthe0, slat0, sphip, sthe0; + double latp, latp1, latp2; + double u, v, x, y, z; + + /* Initialize the projection driver routines. */ + if (prjset(pcode, prj)) { + return 1; + } + + /* Set default for native longitude of the celestial pole? */ + dophip = (cel->ref[2] == 999.0); + + /* Compute celestial coordinates of the native pole. */ + if (prj->theta0 == 90.0) { + /* Reference point is at the native pole. */ + + if (dophip) { + /* Set default for longitude of the celestial pole. */ + cel->ref[2] = 180.0; + } + + latp = cel->ref[1]; + cel->ref[3] = latp; + + cel->euler[0] = cel->ref[0]; + cel->euler[1] = 90.0 - latp; + } else { + /* Reference point away from the native pole. */ + + /* Set default for longitude of the celestial pole. */ + if (dophip) { + cel->ref[2] = (cel->ref[1] < prj->theta0) ? 180.0 : 0.0; + } + + clat0 = cosdeg (cel->ref[1]); + slat0 = sindeg (cel->ref[1]); + cphip = cosdeg (cel->ref[2]); + sphip = sindeg (cel->ref[2]); + cthe0 = cosdeg (prj->theta0); + sthe0 = sindeg (prj->theta0); + + x = cthe0*cphip; + y = sthe0; + z = sqrt(x*x + y*y); + if (z == 0.0) { + if (slat0 != 0.0) { + return 1; + } + + /* latp determined by LATPOLE in this case. */ + latp = cel->ref[3]; + } else { + if (fabs(slat0/z) > 1.0) { + return 1; + } + + u = atan2deg (y,x); + v = acosdeg (slat0/z); + + latp1 = u + v; + if (latp1 > 180.0) { + latp1 -= 360.0; + } else if (latp1 < -180.0) { + latp1 += 360.0; + } + + latp2 = u - v; + if (latp2 > 180.0) { + latp2 -= 360.0; + } else if (latp2 < -180.0) { + latp2 += 360.0; + } + + if (fabs(cel->ref[3]-latp1) < fabs(cel->ref[3]-latp2)) { + if (fabs(latp1) < 90.0+tol) { + latp = latp1; + } else { + latp = latp2; + } + } else { + if (fabs(latp2) < 90.0+tol) { + latp = latp2; + } else { + latp = latp1; + } + } + + cel->ref[3] = latp; + } + + cel->euler[1] = 90.0 - latp; + + z = cosdeg (latp)*clat0; + if (fabs(z) < tol) { + if (fabs(clat0) < tol) { + /* Celestial pole at the reference point. */ + cel->euler[0] = cel->ref[0]; + cel->euler[1] = 90.0 - prj->theta0; + } else if (latp > 0.0) { + /* Celestial pole at the native north pole.*/ + cel->euler[0] = cel->ref[0] + cel->ref[2] - 180.0; + cel->euler[1] = 0.0; + } else if (latp < 0.0) { + /* Celestial pole at the native south pole. */ + cel->euler[0] = cel->ref[0] - cel->ref[2]; + cel->euler[1] = 180.0; + } + } else { + x = (sthe0 - sindeg (latp)*slat0)/z; + y = sphip*cthe0/clat0; + if (x == 0.0 && y == 0.0) { + return 1; + } + cel->euler[0] = cel->ref[0] - atan2deg (y,x); + } + + /* Make euler[0] the same sign as ref[0]. */ + if (cel->ref[0] >= 0.0) { + if (cel->euler[0] < 0.0) cel->euler[0] += 360.0; + } else { + if (cel->euler[0] > 0.0) cel->euler[0] -= 360.0; + } + } + + cel->euler[2] = cel->ref[2]; + cel->euler[3] = cosdeg (cel->euler[1]); + cel->euler[4] = sindeg (cel->euler[1]); + cel->flag = CELSET; + + /* Check for ill-conditioned parameters. */ + if (fabs(latp) > 90.0+tol) { + return 2; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int +celfwd(pcode, lng, lat, cel, phi, theta, prj, x, y) + +const char pcode[4]; +const double lng, lat; +struct celprm *cel; +double *phi, *theta; +struct prjprm *prj; +double *x, *y; + +{ + int err; + + if (cel->flag != CELSET) { + if (celset(pcode, cel, prj)) return 1; + } + + /* Compute native coordinates. */ + sphfwd(lng, lat, cel->euler, phi, theta); + + /* Apply forward projection. */ + if ((err = prj->prjfwd(*phi, *theta, prj, x, y))) { + return err == 1 ? 2 : 3; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int +celrev(pcode, x, y, prj, phi, theta, cel, lng, lat) + +const char pcode[4]; +const double x, y; +struct prjprm *prj; +double *phi, *theta; +struct celprm *cel; +double *lng, *lat; + +{ + int err; + + if (cel->flag != CELSET) { + if(celset(pcode, cel, prj)) return 1; + } + + /* Apply reverse projection. */ + if ((err = prj->prjrev(x, y, prj, phi, theta))) { + return err == 1 ? 2 : 3; + } + + /* Compute native coordinates. */ + sphrev(*phi, *theta, cel->euler, lng, lat); + + return 0; +} + +/* Dec 20 1999 Doug Mink - Change cosd() and sind() to cosdeg() and sindeg() + * Dec 20 1999 Doug Mink - Include wcslib.h, which includes wcsmath.h and cel.h + * + * Dec 18 2000 Doug Mink - Include string.h for strcmp() + * + * Mar 20 2001 Doug Mink - Add () around err assignments in if statements + * Sep 19 2001 Doug Mink - Add above changes to WCSLIB-2.7 cel.c + * + * Mar 12 2002 Doug Mink - Add changes to WCSLIB-2.8.2 cel.c + */ diff --git a/tksao/wcssubs/dateutil.c b/tksao/wcssubs/dateutil.c new file mode 100644 index 0000000..ada0c95 --- /dev/null +++ b/tksao/wcssubs/dateutil.c @@ -0,0 +1,4554 @@ +/*** File libwcs/dateutil.c + *** October 19, 2012 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1999-2012 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +/* Date and time conversion routines using the following conventions: + ang = Angle in fractional degrees + deg = Angle in degrees as dd:mm:ss.ss + doy = 2 floating point numbers: year and day, including fraction, of year + *** First day of year is 1, not zero. + dt = 2 floating point numbers: yyyy.mmdd, hh.mmssssss + ep = fractional year, often epoch of a position including proper motion + epb = Besselian epoch = 365.242198781-day years based on 1900.0 + epj = Julian epoch = 365.25-day years based on 2000.0 + fd = FITS date string which may be any of the following: + yyyy.ffff (fractional year) + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) + hr = Sexigesimal hours as hh:mm:dd.ss + jd = Julian Date + lt = Local time + mjd = modified Julian Date = JD - 2400000.5 + ofd = FITS date string (dd/mm/yy before 2000, else no return) + time = use fd2* with no date to convert time as hh:mm:ss.ss to sec, day, year + ts = UT seconds since 1950-01-01T00:00 (used for ephemeris computations) + tsi = local seconds since 1980-01-01T00:00 (used by IRAF as a time tag) + tsu = UT seconds since 1970-01-01T00:00 (used as Unix system time) + tsd = UT seconds of current day + ut = Universal Time (UTC) + et = Ephemeris Time (or TDB or TT) = TAI + 32.184 seconds + tai = International Atomic Time (Temps Atomique International) = ET - 32.184 seconds + gps = GPS time = TAI - 19 seconds + mst = Mean Greenwich Sidereal Time + gst = Greenwich Sidereal Time (includes nutation) + lst = Local Sidereal Time (includes nutation) (longitude must be set) + hjd = Heliocentric Julian Date + mhjd = modified Heliocentric Julian Date = HJD - 2400000.5 + + * ang2hr (angle) + * Convert angle in decimal floating point degrees to hours as hh:mm:ss.ss + * ang2deg (angle) + * Convert angle in decimal floating point degrees to degrees as dd:mm:ss.ss + * deg2ang (angle as dd:mm:ss.ss) + * Convert angle in degrees as dd:mm:ss.ss to decimal floating point degrees + * ang2hr (angle) + * Convert angle in hours as hh:mm:ss.ss to decimal floating point degrees + * + * doy2dt (year, doy, date, time) + * Convert year and day of year to date as yyyy.ddmm and time as hh.mmsss + * doy2ep, doy2epb, doy2epj (date, time) + * Convert year and day of year to fractional year + * doy2fd (year, doy) + * Convert year and day of year to FITS date string + * doy2mjd (year, doy) + * Convert year and day of year to modified Julian date + * + * dt2doy (date, time, year, doy) + * Convert date as yyyy.ddmm and time as hh.mmsss to year and day of year + * dt2ep, dt2epb, dt2epj (date, time) + * Convert date as yyyy.ddmm and time as hh.mmsss to fractional year + * dt2fd (date, time) + * Convert date as yyyy.ddmm and time as hh.mmsss to FITS date string + * dt2i (date,time,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert yyyy.mmdd hh.mmssss to year month day hours minutes seconds + * dt2jd (date,time) + * Convert date as yyyy.ddmm and time as hh.mmsss to Julian date + * dt2mjd (date,time) + * Convert date as yyyy.ddmm and time as hh.mmsss to modified Julian date + * dt2ts (date,time) + * Convert date (yyyy.ddmm) and time (hh.mmsss) to seconds since 1950-01-01 + * dt2tsi (date,time) + * Convert date (yyyy.ddmm) and time (hh.mmsss) to seconds since 1980-01-01 + * dt2tsu (date,time) + * Convert date (yyyy.ddmm) and time (hh.mmsss) to seconds since 1970-01-01 + * + * ep2dt, epb2dt, epj2dt (epoch,date, time) + * Convert fractional year to date as yyyy.ddmm and time as hh.mmsss + * ep2fd, epb2fd, epj2fd (epoch) + * Convert epoch to FITS ISO date string + * ep2i, epb2i, epj2i (epoch,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert fractional year to year month day hours minutes seconds + * ep2jd, epb2jd, epj2jd (epoch) + * Convert fractional year as used in epoch to Julian date + * ep2mjd, epb2mjd, epj2mjd (epoch) + * Convert fractional year as used in epoch to modified Julian date + * ep2ts, epb2ts, epj2ts (epoch) + * Convert fractional year to seconds since 1950.0 + * + * et2fd (string) + * Convert from ET (or TDT or TT) in FITS format to UT in FITS format + * fd2et (string) + * Convert from UT in FITS format to ET (or TDT or TT) in FITS format + * jd2jed (dj) + * Convert from Julian Date to Julian Ephemeris Date + * jed2jd (dj) + * Convert from Julian Ephemeris Date to Julian Date + * dt2et (date, time) + * Convert date (yyyy.ddmm) and time (hh.mmsss) to ephemeris time + * edt2dt (date, time) + * Convert ephemeris date (yyyy.ddmm) and time (hh.mmsss) to UT + * dt2tai (date, time) + * Convert date (yyyy.ddmm) and time (hh.mmsss) to TAI date and time + * tai2dt (date, time) + * Convert TAI date (yyyy.ddmm) and time (hh.mmsss) to UT + * ts2ets (tsec) + * Convert from UT in seconds since 1950-01-01 to ET in same format + * ets2ts (tsec) + * Convert from ET in seconds since 1950-01-01 to UT in same format + * + * fd2ep, fd2epb, fd2epj (string) + * Convert FITS date string to fractional year + * Convert time alone to fraction of Besselian year + * fd2doy (string, year, doy) + * Convert FITS standard date string to year and day of year + * fd2dt (string, date, time) + * Convert FITS date string to date as yyyy.ddmm and time as hh.mmsss + * Convert time alone to hh.mmssss with date set to 0.0 + * fd2i (string,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert FITS standard date string to year month day hours min sec + * Convert time alone to hours min sec, year month day are zero + * fd2jd (string) + * Convert FITS standard date string to Julian date + * Convert time alone to fraction of day + * fd2mjd (string) + * Convert FITS standard date string to modified Julian date + * fd2ts (string) + * Convert FITS standard date string to seconds since 1950.0 + * Convert time alone to seconds of day + * fd2fd (string) + * Convert FITS standard date string to ISO FITS date string + * fd2of (string) + * Convert FITS standard date string to old-format FITS date and time + * fd2ofd (string) + * Convert FITS standard date string to old-format FITS date string + * fd2oft (string) + * Convert time part of FITS standard date string to FITS date string + * + * jd2doy (dj, year, doy) + * Convert Julian date to year and day of year + * jd2dt (dj,date,time) + * Convert Julian date to date as yyyy.mmdd and time as hh.mmssss + * jd2ep, jd2epb, jd2epj (dj) + * Convert Julian date to fractional year as used in epoch + * jd2fd (dj) + * Convert Julian date to FITS ISO date string + * jd2i (dj,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert Julian date to year month day hours min sec + * jd2mjd (dj) + * Convert Julian date to modified Julian date + * jd2ts (dj) + * Convert Julian day to seconds since 1950.0 + * + * lt2dt() + * Return local time as yyyy.mmdd and time as hh.mmssss + * lt2fd() + * Return local time as FITS ISO date string + * lt2tsi() + * Return local time as IRAF seconds since 1980-01-01 00:00 + * lt2tsu() + * Return local time as Unix seconds since 1970-01-01 00:00 + * lt2ts() + * Return local time as Unix seconds since 1950-01-01 00:00 + * + * mjd2doy (dj,year,doy) + * Convert modified Julian date to date as year and day of year + * mjd2dt (dj,date,time) + * Convert modified Julian date to date as yyyy.mmdd and time as hh.mmssss + * mjd2ep, mjd2epb, mjd2epj (dj) + * Convert modified Julian date to fractional year as used in epoch + * mjd2fd (dj) + * Convert modified Julian date to FITS ISO date string + * mjd2i (dj,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert modified Julian date to year month day hours min sec + * mjd2jd (dj) + * Convert modified Julian date to Julian date + * mjd2ts (dj) + * Convert modified Julian day to seconds since 1950.0 + * + * ts2dt (tsec,date,time) + * Convert seconds since 1950.0 to date as yyyy.ddmm and time as hh.mmsss + * ts2ep, ts2epb, ts2epj (tsec) + * Convert seconds since 1950.0 to fractional year + * ts2fd (tsec) + * Convert seconds since 1950.0 to FITS standard date string + * ts2i (tsec,iyr,imon,iday,ihr,imn,sec, ndsec) + * Convert sec since 1950.0 to year month day hours minutes seconds + * ts2jd (tsec) + * Convert seconds since 1950.0 to Julian date + * ts2mjd (tsec) + * Convert seconds since 1950.0 to modified Julian date + * tsi2fd (tsec) + * Convert seconds since 1980-01-01 to FITS standard date string + * tsi2dt (tsec,date,time) + * Convert seconds since 1980-01-01 to date as yyyy.ddmm, time as hh.mmsss + * tsu2fd (tsec) + * Convert seconds since 1970-01-01 to FITS standard date string + * tsu2tsi (tsec) + * Convert UT seconds since 1970-01-01 to local seconds since 1980-01-01 + * tsu2dt (tsec,date,time) + * Convert seconds since 1970-01-01 to date as yyyy.ddmm, time as hh.mmsss + * + * tsd2fd (tsec) + * Convert seconds since start of day to FITS time, hh:mm:ss.ss + * tsd2dt (tsec) + * Convert seconds since start of day to hh.mmssss + * + * fd2gst (string) + * convert from FITS date Greenwich Sidereal Time + * dt2gst (date, time) + * convert from UT as yyyy.mmdd hh.mmssss to Greenwich Sidereal Time + * ts2gst (tsec) + * Calculate Greenwich Sidereal Time given Universal Time + * in seconds since 1951-01-01T0:00:00 + * fd2mst (string) + * convert from FITS UT date to Mean Sidereal Time + * dt2gmt (date, time) + * convert from UT as yyyy.mmdd hh.mmssss to Mean Sidereal Time + * ts2mst (tsec) + * Calculate Mean Sidereal Time given Universal Time + * in seconds since 1951-01-01T0:00:00 + * jd2mst (string) + * convert from Julian Date to Mean Sidereal Time + * mst2fd (string) + * convert to current UT in FITS format given Greenwich Mean Sidereal Time + * mst2jd (dj) + * convert to current UT as Julian Date given Greenwich Mean Sidereal Time + * jd2lst (dj) + * Calculate Local Sidereal Time from Julian Date + * ts2lst (tsec) + * Calculate Local Sidereal Time given UT in seconds since 1951-01-01T0:00 + * fd2lst (string) + * Calculate Local Sidereal Time given Universal Time as FITS ISO date + * lst2jd (dj, lst) + * Calculate Julian Date given current Julian date and Local Sidereal Time + * lst2fd (string, lst) + * Calculate Julian Date given current UT date and Local Sidereal Time + * gst2fd (string) + * Calculate current UT given UT date and Greenwich Sidereal Time + * gst2jd (dj) + * Calculate current UT given UT date and Greenwich Sidereal Time as JD + * + * compnut (dj, dpsi, deps, eps0) + * Compute the longitude and obliquity components of nutation and + * mean obliquity from the IAU 1980 theory + * + * utdt (dj) + * Compute difference between UT and dynamical time (ET-UT) + * ut2dt (year, doy) + * Current Universal Time to year and day of year + * ut2dt (date, time) + * Current Universal Time to date (yyyy.mmdd) and time (hh.mmsss) + * ut2ep(), ut2epb(), ut2epj() + * Current Universal Time to fractional year, Besselian, Julian epoch + * ut2fd() + * Current Universal Time to FITS ISO date string + * ut2jd() + * Current Universal Time to Julian Date + * ut2mjd() + * Current Universal Time to Modified Julian Date + * ut2tsi() + * Current Universal Time to IRAF seconds since 1980-01-01T00:00 + * ut2tsu() + * Current Universal Time to Unix seconds since 1970-01-01T00:00 + * ut2ts() + * Current Universal Time to seconds since 1950-01-01T00:00 + * isdate (string) + * Return 1 if string is a FITS date (old or ISO) + * + * Internally-used subroutines + * + * fixdate (iyr, imon, iday, ihr, imn, sec, ndsec) + * Round seconds and make sure date and time numbers are within limits + * caldays (year, month) + * Calculate days in month 1-12 given year (Gregorian calendar only + * dint (dnum) + * Return integer part of floating point number + * dmod (dnum) + * Return Mod of floating point number + */ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <math.h> +#include <time.h> +#include <sys/time.h> +#include "wcs.h" +#include "fitsfile.h" + +static double suntl(); +static void fixdate(); +static int caldays(); +static double dint(); +static double dmod(); + +static double longitude = 0.0; /* longitude of observatory in degrees (+=west) */ +void +setlongitude (longitude0) +double longitude0; +{ longitude = longitude0; return; } + +static int ndec = 3; +void +setdatedec (nd) +int nd; +{ ndec = nd; return; } + +/* ANG2HR -- Convert angle in fraction degrees to hours as hh:mm:ss.ss */ + +void +ang2hr (angle, lstr, string) + +double angle; /* Angle in fractional degrees */ +int lstr; /* Maximum number of characters in string */ +char *string; /* Character string (hh:mm:ss.ss returned) */ + +{ + angle = angle / 15.0; + dec2str (string, lstr, angle, ndec); + return; +} + + +/* ANG2DEG -- Convert angle in fraction degrees to degrees as dd:mm:ss.ss */ + +void +ang2deg (angle, lstr, string) + +double angle; /* Angle in fractional degrees */ +int lstr; /* Maximum number of characters in string */ +char *string; /* Character string (dd:mm:ss.ss returned) */ +{ + dec2str (string, lstr, angle, ndec); + return; +} + + +/* DEG2ANG -- Convert angle in degrees as dd:mm:ss.ss to fractional degrees */ + +double +deg2ang (angle) + +char *angle; /* Angle as dd:mm:ss.ss */ +{ + double deg; + + deg = str2dec (angle); + return (deg); +} + +/* HR2ANG -- Convert angle in hours as hh:mm:ss.ss to fractional degrees */ + +double +hr2ang (angle) + +char *angle; /* Angle in sexigesimal hours (hh:mm:ss.sss) */ + +{ + double deg; + + deg = str2dec (angle); + deg = deg * 15.0; + return (deg); +} + + +/* DT2FD-- convert vigesimal date and time to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +dt2fd (date, time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + int nf; + char *string; + char tstring[32], dstring[32]; + char outform[64]; + + dt2i (date, time, &iyr,&imon,&iday,&ihr,&imn,&sec, ndec); + + /* Convert to ISO date format */ + string = (char *) calloc (32, sizeof (char)); + + /* Make time string */ + if (time != 0.0 || ndec > 0) { + if (ndec == 0) + nf = 2; + else + nf = 3 + ndec; + if (ndec > 0) { + sprintf (outform, "%%02d:%%02d:%%0%d.%df", nf, ndec); + sprintf (tstring, outform, ihr, imn, sec); + } + else { + sprintf (outform, "%%02d:%%02d:%%0%dd", nf); + sprintf (tstring, outform, ihr, imn, (int)(sec+0.5)); + } + } + + /* Make date string */ + if (date != 0.0) + sprintf (dstring, "%4d-%02d-%02d", iyr, imon, iday); + + /* Make FITS (ISO) date string */ + if (date == 0.0) + strcpy (string, tstring); + else if (time == 0.0 && ndec < 1) + strcpy (string, dstring); + else + sprintf (string, "%sT%s", dstring, tstring); + + return (string); +} + + +/* DT2JD-- convert from date as yyyy.mmdd and time as hh.mmsss to Julian Date + * Return fractional days if date is zero */ + +double +dt2jd (date,time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Julian date (returned) */ + double tsec; /* seconds since 1950.0 */ + + tsec = dt2ts (date, time); + if (date == 0.0) + dj = tsec / 86400.0; + else + dj = ts2jd (tsec); + + return (dj); +} + + +/* DT2MJD-- convert from date yyyy.mmdd time hh.mmsss to modified Julian Date + * Return fractional days if date is zero */ + +double +dt2mjd (date,time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Modified Julian date (returned) */ + double tsec; /* seconds since 1950.0 */ + + tsec = dt2ts (date, time); + if (date == 0.0) + dj = tsec / 86400.0; + else + dj = ts2jd (tsec); + + return (dj - 2400000.5); +} + + +/* HJD2JD-- convert Heliocentric Julian Date to (geocentric) Julian date */ + +double +hjd2jd (dj, ra, dec, sys) + +double dj; /* Heliocentric Julian date */ +double ra; /* Right ascension (degrees) */ +double dec; /* Declination (degrees) */ +int sys; /* J2000, B1950, GALACTIC, ECLIPTIC */ +{ + double lt; /* Light travel difference to the Sun (days) */ + + lt = suntl (dj, ra, dec, sys); + + /* Return Heliocentric Julian Date */ + return (dj - lt); +} + + +/* JD2HJD-- convert (geocentric) Julian date to Heliocentric Julian Date */ + +double +jd2hjd (dj, ra, dec, sys) + +double dj; /* Julian date (geocentric) */ +double ra; /* Right ascension (degrees) */ +double dec; /* Declination (degrees) */ +int sys; /* J2000, B1950, GALACTIC, ECLIPTIC */ +{ + double lt; /* Light travel difference to the Sun (days) */ + + lt = suntl (dj, ra, dec, sys); + + /* Return Heliocentric Julian Date */ + return (dj + lt); +} + + +/* MHJD2MJD-- convert modified Heliocentric Julian Date to + modified geocentric Julian date */ + +double +mhjd2mjd (mhjd, ra, dec, sys) + +double mhjd; /* Modified Heliocentric Julian date */ +double ra; /* Right ascension (degrees) */ +double dec; /* Declination (degrees) */ +int sys; /* J2000, B1950, GALACTIC, ECLIPTIC */ +{ + double lt; /* Light travel difference to the Sun (days) */ + double hjd; /* Heliocentric Julian date */ + + hjd = mjd2jd (mhjd); + + lt = suntl (hjd, ra, dec, sys); + + /* Return Heliocentric Julian Date */ + return (jd2mjd (hjd - lt)); +} + + +/* MJD2MHJD-- convert modified geocentric Julian date tp + modified Heliocentric Julian Date */ + +double +mjd2mhjd (mjd, ra, dec, sys) + +double mjd; /* Julian date (geocentric) */ +double ra; /* Right ascension (degrees) */ +double dec; /* Declination (degrees) */ +int sys; /* J2000, B1950, GALACTIC, ECLIPTIC */ +{ + double lt; /* Light travel difference to the Sun (days) */ + double dj; /* Julian date (geocentric) */ + + dj = mjd2jd (mjd); + + lt = suntl (dj, ra, dec, sys); + + /* Return Heliocentric Julian Date */ + return (jd2mjd (dj + lt)); +} + + +/* SUNTL-- compute light travel time to heliocentric correction in days */ +/* Translated into C from IRAF SPP noao.astutils.asttools.asthjd.x */ + +static double +suntl (dj, ra, dec, sys) + +double dj; /* Julian date (geocentric) */ +double ra; /* Right ascension (degrees) */ +double dec; /* Declination (degrees) */ +int sys; /* J2000, B1950, GALACTIC, ECLIPTIC */ +{ + double t; /* Number of Julian centuries since J1900 */ + double manom; /* Mean anomaly of the Earth's orbit (degrees) */ + double lperi; /* Mean longitude of perihelion (degrees) */ + double oblq; /* Mean obliquity of the ecliptic (degrees) */ + double eccen; /* Eccentricity of the Earth's orbit (dimensionless) */ + double eccen2, eccen3; + double tanom; /* True anomaly (approximate formula) (radians) */ + double slong; /* True longitude of the Sun from the Earth (radians) */ + double rs; /* Distance to the sun (AU) */ + double lt; /* Light travel difference to the Sun (days) */ + double l; /* Longitude of star in orbital plane of Earth (radians) */ + double b; /* Latitude of star in orbital plane of Earth (radians) */ + double epoch; /* Epoch of obervation */ + double rs1,rs2; + + t = (dj - 2415020.0) / 36525.0; + + /* Compute earth orbital parameters */ + manom = 358.47583 + (t * (35999.04975 - t * (0.000150 + t * 0.000003))); + lperi = 101.22083 + (t * (1.7191733 + t * (0.000453 + t * 0.000003))); + oblq = 23.452294 - (t * (0.0130125 + t * (0.00000164 - t * 0.000000503))); + eccen = 0.01675104 - (t * (0.00004180 + t * 0.000000126)); + eccen2 = eccen * eccen; + eccen3 = eccen * eccen2; + + /* Convert to principle angles */ + manom = manom - (360.0 * (dint) (manom / 360.0)); + lperi = lperi - (360.0 * (dint) (lperi / 360.0)); + + /* Convert to radians */ + manom = degrad (manom); + lperi = degrad (lperi); + oblq = degrad (oblq); + + /* True anomaly */ + tanom = manom + (2 * eccen - 0.25 * eccen3) * sin (manom) + + 1.25 * eccen2 * sin (2 * manom) + + 13./12. * eccen3 * sin (3 * manom); + + /* Distance to the Sun */ + rs1 = 1.0 - eccen2; + rs2 = 1.0 + (eccen * cos (tanom)); + rs = rs1 / rs2; + + /* True longitude of the Sun seen from the Earth */ + slong = lperi + tanom + PI; + + /* Longitude and latitude of star in orbital plane of the Earth */ + epoch = jd2ep (dj); + wcscon (sys, WCS_ECLIPTIC, 0.0, 0.0, &ra, &dec, epoch); + l = degrad (ra); + b = degrad (dec); + + /* Light travel difference to the Sun */ + lt = -0.005770 * rs * cos (b) * cos (l - slong); + + /* Return light travel difference */ + return (lt); +} + + +/* JD2DT-- convert Julian date to date as yyyy.mmdd and time as hh.mmssss */ + +void +jd2dt (dj,date,time) + +double dj; /* Julian date */ +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + /* Convert Julian Date to date and time */ + jd2i (dj, &iyr, &imon, &iday, &ihr, &imn, &sec, 4); + + /* Convert date to yyyy.mmdd */ + if (iyr < 0) { + *date = (double) (-iyr) + 0.01 * (double) imon + 0.0001 * (double) iday; + *date = -(*date); + } + else + *date = (double) iyr + 0.01 * (double) imon + 0.0001 * (double) iday; + + /* Convert time to hh.mmssssss */ + *time = (double) ihr + 0.01 * (double) imn + 0.0001 * sec; + + return; +} + + +/* JD2I-- convert Julian date to date as year, month, and day, and time hours, + minutes, and seconds */ +/* after Fliegel and Van Flander, CACM 11, 657 (1968) */ + + +void +jd2i (dj, iyr, imon, iday, ihr, imn, sec, ndsec) + +double dj; /* Julian date */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ + +{ + double tsec; + double frac, dts, ts, sday; + int jd, l, n, i, j; + + tsec = jd2ts (dj); + /* ts2i (tsec, iyr, imon, iday, ihr, imn, sec, ndsec); */ + + /* Round seconds to 0 - 4 decimal places */ + if (tsec < 0.0) + dts = -0.5; + else + dts = 0.5; + if (ndsec < 1) + ts = dint (tsec + dts); + else if (ndsec < 2) + ts = dint (tsec * 10.0 + dts) / 10.0; + else if (ndsec < 3) + ts = dint (tsec * 100.0 + dts) / 100.0; + else if (ndsec < 4) + ts = dint (tsec * 1000.0 + dts) / 1000.0; + else + ts = dint (tsec * 10000.0 + dts) / 10000.0; + + /* Convert back to Julian Date */ + dj = ts2jd (ts); + + /* Compute time from fraction of a day */ + frac = dmod (dj, 1.0); + if (frac < 0.5) { + jd = (int) (dj - frac); + sday = (frac + 0.5) * 86400.0; + } + else { + jd = (int) (dj - frac) + 1; + sday = (frac - 0.5) * 86400.0; + } + + *ihr = (int) (sday / 3600.0); + sday = sday - (double) (*ihr * 3600); + *imn = (int) (sday / 60.0); + *sec = sday - (double) (*imn * 60); + + /* Compute day, month, year */ + l = jd + 68569; + n = (4 * l) / 146097; + l = l - (146097 * n + 3) / 4; + i = (4000 * (l + 1)) / 1461001; + l = l - (1461 * i) / 4 + 31; + j = (80 * l) / 2447; + *iday = l - (2447 * j) / 80; + l = j / 11; + *imon = j + 2 - (12 * l); + *iyr = 100 * (n - 49) + i + l; + + return; +} + + +/* JD2MJD-- convert Julian Date to Modified Julian Date */ + +double +jd2mjd (dj) + +double dj; /* Julian Date */ + +{ + return (dj - 2400000.5); +} + + +/* JD2EP-- convert Julian date to fractional year as used in epoch */ + +double +jd2ep (dj) + +double dj; /* Julian date */ + +{ + double date, time; + jd2dt (dj, &date, &time); + return (dt2ep (date, time)); +} + + +/* JD2EPB-- convert Julian date to Besselian epoch */ + +double +jd2epb (dj) + +double dj; /* Julian date */ + +{ + return (1900.0 + (dj - 2415020.31352) / 365.242198781); +} + + +/* JD2EPJ-- convert Julian date to Julian epoch */ + +double +jd2epj (dj) + +double dj; /* Julian date */ + +{ + return (2000.0 + (dj - 2451545.0) / 365.25); +} + + +/* LT2DT-- Return local time as yyyy.mmdd and time as hh.mmssss */ + +void +lt2dt(date, time) + +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ + +{ + time_t tsec; + struct timeval tp; + struct timezone tzp; + struct tm *ts; + + gettimeofday (&tp,&tzp); + + tsec = tp.tv_sec; + ts = localtime (&tsec); + + if (ts->tm_year < 1000) + *date = (double) (ts->tm_year + 1900); + else + *date = (double) ts->tm_year; + *date = *date + (0.01 * (double) (ts->tm_mon + 1)); + *date = *date + (0.0001 * (double) ts->tm_mday); + *time = (double) ts->tm_hour; + *time = *time + (0.01 * (double) ts->tm_min); + *time = *time + (0.0001 * (double) ts->tm_sec); + + return; +} + + +/* LT2FD-- Return current local time as FITS ISO date string */ + +char * +lt2fd() +{ + time_t tsec; + struct tm *ts; + struct timeval tp; + struct timezone tzp; + int month, day, year, hour, minute, second; + char *isotime; + + gettimeofday (&tp,&tzp); + tsec = tp.tv_sec; + + ts = localtime (&tsec); + + year = ts->tm_year; + if (year < 1000) + year = year + 1900; + month = ts->tm_mon + 1; + day = ts->tm_mday; + hour = ts->tm_hour; + minute = ts->tm_min; + second = ts->tm_sec; + + isotime = (char *) calloc (32, sizeof (char)); + sprintf (isotime, "%04d-%02d-%02dT%02d:%02d:%02d", + year, month, day, hour, minute, second); + return (isotime); +} + + +/* LT2TSI-- Return local time as IRAF seconds since 1980-01-01 00:00 */ + +int +lt2tsi() +{ + return ((int)(lt2ts() - 946684800.0)); +} + + +/* LT2TSU-- Return local time as Unix seconds since 1970-01-01 00:00 */ + +time_t +lt2tsu() +{ + return ((time_t)(lt2ts() - 631152000.0)); +} + +/* LT2TS-- Return local time as Unix seconds since 1950-01-01 00:00 */ + +double +lt2ts() +{ + double tsec; + char *datestring; + datestring = lt2fd(); + tsec = fd2ts (datestring); + free (datestring); + return (tsec); +} + + +/* MJD2DT-- convert Modified Julian Date to date (yyyy.mmdd) time (hh.mmssss) */ + +void +mjd2dt (dj,date,time) + +double dj; /* Modified Julian Date */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double tsec; + + tsec = jd2ts (dj + 2400000.5); + ts2dt (tsec, date, time); + + return; +} + + +/* MJD2I-- convert Modified Julian Date to date as year, month, day and + time as hours, minutes, seconds */ + +void +mjd2i (dj, iyr, imon, iday, ihr, imn, sec, ndsec) + +double dj; /* Modified Julian Date */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ + +{ + double tsec; + + tsec = jd2ts (dj + 2400000.5); + ts2i (tsec, iyr, imon, iday, ihr, imn, sec, ndsec); + return; +} + + +/* MJD2DOY-- convert Modified Julian Date to Year,Day-of-Year */ + +void +mjd2doy (dj, year, doy) + +double dj; /* Modified Julian Date */ +int *year; /* Year (returned) */ +double *doy; /* Day of year with fraction (returned) */ + +{ + jd2doy (dj + 2400000.5, year, doy); + return; +} + + +/* MJD2JD-- convert Modified Julian Date to Julian Date */ + +double +mjd2jd (dj) + +double dj; /* Modified Julian Date */ + +{ + return (dj + 2400000.5); +} + + +/* MJD2EP-- convert Modified Julian Date to fractional year */ + +double +mjd2ep (dj) + +double dj; /* Modified Julian Date */ + +{ + double date, time; + jd2dt (dj + 2400000.5, &date, &time); + return (dt2ep (date, time)); +} + + +/* MJD2EPB-- convert Modified Julian Date to Besselian epoch */ + +double +mjd2epb (dj) + +double dj; /* Modified Julian Date */ + +{ + return (1900.0 + (dj - 15019.81352) / 365.242198781); +} + + +/* MJD2EPJ-- convert Modified Julian Date to Julian epoch */ + +double +mjd2epj (dj) + +double dj; /* Modified Julian Date */ + +{ + return (2000.0 + (dj - 51544.5) / 365.25); +} + + +/* MJD2FD-- convert modified Julian date to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +mjd2fd (dj) + +double dj; /* Modified Julian date */ +{ + return (jd2fd (dj + 2400000.5)); +} + + +/* MJD2TS-- convert modified Julian date to seconds since 1950.0 */ + +double +mjd2ts (dj) + +double dj; /* Modified Julian date */ +{ + return ((dj - 33282.0) * 86400.0); +} + + +/* EP2FD-- convert fractional year to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +ep2fd (epoch) + +double epoch; /* Date as fractional year */ +{ + double tsec; /* seconds since 1950.0 (returned) */ + tsec = ep2ts (epoch); + return (ts2fd (tsec)); +} + + +/* EPB2FD-- convert Besselian epoch to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +epb2fd (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +{ + double dj; /* Julian Date */ + dj = epb2jd (epoch); + return (jd2fd (dj)); +} + + +/* EPJ2FD-- convert Julian epoch to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +epj2fd (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +{ + double dj; /* Julian Date */ + dj = epj2jd (epoch); + return (jd2fd (dj)); +} + + +/* EP2TS-- convert fractional year to seconds since 1950.0 */ + +double +ep2ts (epoch) + +double epoch; /* Date as fractional year */ +{ + double dj; + dj = ep2jd (epoch); + return ((dj - 2433282.5) * 86400.0); +} + + +/* EPB2TS-- convert Besselian epoch to seconds since 1950.0 */ + +double +epb2ts (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +{ + double dj; + dj = epb2jd (epoch); + return ((dj - 2433282.5) * 86400.0); +} + + +/* EPJ2TS-- convert Julian epoch to seconds since 1950.0 */ + +double +epj2ts (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +{ + double dj; + dj = epj2jd (epoch); + return ((dj - 2433282.5) * 86400.0); +} + + +/* EPB2EP-- convert Besselian epoch to fractional years */ + +double +epb2ep (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +{ + double dj; + dj = epb2jd (epoch); + return (jd2ep (dj)); +} + + +/* EP2EPB-- convert fractional year to Besselian epoch */ + +double +ep2epb (epoch) + +double epoch; /* Fractional year */ +{ + double dj; + dj = ep2jd (epoch); + return (jd2epb (dj)); +} + + +/* EPJ2EP-- convert Julian epoch to fractional year */ + +double +epj2ep (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +{ + double dj; + dj = epj2jd (epoch); + return (jd2ep (dj)); +} + + +/* EP2EPJ-- convert fractional year to Julian epoch */ + +double +ep2epj (epoch) + +double epoch; /* Fractional year */ +{ + double dj; + dj = ep2jd (epoch); + return (jd2epj (dj)); +} + + +/* EP2I-- convert fractional year to year month day hours min sec */ + +void +ep2i (epoch, iyr, imon, iday, ihr, imn, sec, ndsec) + +double epoch; /* Date as fractional year */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ +{ + double date, time; + + ep2dt (epoch, &date, &time); + dt2i (date, time, iyr,imon,iday,ihr,imn,sec, ndsec); + return; +} + + +/* EPB2I-- convert Besselian epoch to year month day hours min sec */ + +void +epb2i (epoch, iyr, imon, iday, ihr, imn, sec, ndsec) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ +{ + double date, time; + + epb2dt (epoch, &date, &time); + dt2i (date, time, iyr,imon,iday,ihr,imn,sec, ndsec); + return; +} + + +/* EPJ2I-- convert Julian epoch to year month day hours min sec */ + +void +epj2i (epoch, iyr, imon, iday, ihr, imn, sec, ndsec) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ +{ + double date, time; + + epj2dt (epoch, &date, &time); + dt2i (date, time, iyr,imon,iday,ihr,imn,sec, ndsec); + return; +} + + +/* EP2JD-- convert fractional year as used in epoch to Julian date */ + +double +ep2jd (epoch) + +double epoch; /* Date as fractional year */ + +{ + double dj; /* Julian date (returned)*/ + double date, time; + + ep2dt (epoch, &date, &time); + dj = dt2jd (date, time); + return (dj); +} + + +/* EPB2JD-- convert Besselian epoch to Julian Date */ + +double +epb2jd (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ + +{ + return (2415020.31352 + ((epoch - 1900.0) * 365.242198781)); +} + + +/* EPJ2JD-- convert Julian epoch to Julian Date */ + +double +epj2jd (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ + +{ + return (2451545.0 + ((epoch - 2000.0) * 365.25)); +} + + +/* EP2MJD-- convert fractional year as used in epoch to modified Julian date */ + +double +ep2mjd (epoch) + +double epoch; /* Date as fractional year */ + +{ + double dj; /* Julian date (returned)*/ + double date, time; + + ep2dt (epoch, &date, &time); + dj = dt2jd (date, time); + return (dj - 2400000.5); +} + + +/* EPB2MJD-- convert Besselian epoch to modified Julian Date */ + +double +epb2mjd (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ + +{ + return (15019.81352 + ((epoch - 1900.0) * 365.242198781)); +} + + +/* EPJ2MJD-- convert Julian epoch to modified Julian Date */ + +double +epj2mjd (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ + +{ + return (51544.5 + ((epoch - 2000.0) * 365.25)); +} + + + +/* EPB2EPJ-- convert Besselian epoch to Julian epoch */ + +double +epb2epj (epoch) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +{ + double dj; /* Julian date */ + dj = epb2jd (epoch); + return (jd2epj (dj)); +} + + +/* EPJ2EPB-- convert Julian epoch to Besselian epoch */ + +double +epj2epb (epoch) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +{ + double dj; /* Julian date */ + dj = epj2jd (epoch); + return (jd2epb (dj)); +} + + +/* JD2FD-- convert Julian date to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +jd2fd (dj) + +double dj; /* Julian date */ +{ + double tsec; /* seconds since 1950.0 (returned) */ + tsec = (dj - 2433282.5) * 86400.0; + return (ts2fd (tsec)); +} + + +/* JD2TS-- convert Julian date to seconds since 1950.0 */ + +double +jd2ts (dj) + +double dj; /* Julian date */ +{ + return ((dj - 2433282.5) * 86400.0); +} + + +/* JD2TSI-- convert Julian date to IRAF seconds since 1980-01-01T0:00 */ + +int +jd2tsi (dj) + +double dj; /* Julian date */ +{ + double ts; + ts = (dj - 2444239.5) * 86400.0; + return ((int) ts); +} + + +/* JD2TSU-- convert Julian date to Unix seconds since 1970-01-01T0:00 */ + +time_t +jd2tsu (dj) + +double dj; /* Julian date */ +{ + return ((time_t)((dj - 2440587.5) * 86400.0)); +} + + +/* DT2DOY-- convert yyyy.mmdd hh.mmss to year and day of year */ + +void +dt2doy (date, time, year, doy) + +double date; /* Date as yyyy.mmdd */ +double time; /* Time as hh.mmssxxxx */ +int *year; /* Year (returned) */ +double *doy; /* Day of year with fraction (returned) */ +{ + double dj; /* Julian date */ + double dj0; /* Julian date on January 1 0:00 */ + double date0; /* January first of date's year */ + double dyear; + + dyear = floor (date); + date0 = dyear + 0.0101; + dj0 = dt2jd (date0, 0.0); + dj = dt2jd (date, time); + *year = (int) (dyear + 0.00000001); + *doy = dj - dj0 + 1.0; + return; +} + + +/* DOY2DT-- convert year and day of year to yyyy.mmdd hh.mmss */ + +void +doy2dt (year, doy, date, time) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ +{ + double dj; /* Julian date */ + double dj0; /* Julian date on January 1 0:00 */ + double date0; /* January first of date's year */ + + date0 = year + 0.0101; + dj0 = dt2jd (date0, 0.0); + dj = dj0 + doy - 1.0; + jd2dt (dj, date, time); + return; +} + + +/* DOY2EP-- convert year and day of year to fractional year as used in epoch */ + +double +doy2ep (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double date, time; + doy2dt (year, doy, &date, &time); + return (dt2ep (date, time)); +} + + + +/* DOY2EPB-- convert year and day of year to Besellian epoch */ + +double +doy2epb (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; + dj = doy2jd (year, doy); + return (jd2epb (dj)); +} + + +/* DOY2EPJ-- convert year and day of year to Julian epoch */ + +double +doy2epj (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; + dj = doy2jd (year, doy); + return (jd2epj (dj)); +} + + +/* DOY2FD-- convert year and day of year to FITS date */ + +char * +doy2fd (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; /* Julian date */ + + dj = doy2jd (year, doy); + return (jd2fd (dj)); +} + + +/* DOY2JD-- convert year and day of year to Julian date */ + +double +doy2jd (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj0; /* Julian date */ + double date; /* Date as yyyy.mmdd (returned) */ + double time; /* Time as hh.mmssxxxx (returned) */ + + date = (double) year + 0.0101; + time = 0.0; + dj0 = dt2jd (date, time); + return (dj0 + doy - 1.0); +} + + +/* DOY2MJD-- convert year and day of year to Julian date */ + +double +doy2mjd (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj0; /* Julian date */ + double date; /* Date as yyyy.mmdd (returned) */ + double time; /* Time as hh.mmssxxxx (returned) */ + + date = (double) year + 0.0101; + time = 0.0; + dj0 = dt2jd (date, time); + return (dj0 + doy - 1.0 - 2400000.5); +} + + +/* DOY2TSU-- convert from FITS date to Unix seconds since 1970-01-01T0:00 */ + +time_t +doy2tsu (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; + dj = doy2jd (year, doy); + return ((time_t)jd2ts (dj)); +} + + +/* DOY2TSI-- convert from FITS date to IRAF seconds since 1980-01-01T0:00 */ + +int +doy2tsi (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; + dj = doy2jd (year, doy); + return ((int)jd2tsi (dj)); +} + + +/* DOY2TS-- convert year, day of year to seconds since 1950 */ + +double +doy2ts (year, doy) + +int year; /* Year */ +double doy; /* Day of year with fraction */ +{ + double dj; + dj = doy2jd (year, doy); + return (jd2ts (dj)); +} + + +/* FD2DOY-- convert FITS date to year and day of year */ + +void +fd2doy (string, year, doy) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +int *year; /* Year (returned) */ +double *doy; /* Day of year with fraction (returned) */ +{ + double dj; /* Julian date */ + + dj = fd2jd (string); + jd2doy (dj, year, doy); + return; +} + + +/* JD2DOY-- convert Julian date to year and day of year */ + +void +jd2doy (dj, year, doy) + +double dj; /* Julian date */ +int *year; /* Year (returned) */ +double *doy; /* Day of year with fraction (returned) */ +{ + double date; /* Date as yyyy.mmdd (returned) */ + double time; /* Time as hh.mmssxxxx (returned) */ + double dj0; /* Julian date at 0:00 on 1/1 */ + double dyear; + + jd2dt (dj, &date, &time); + *year = (int) date; + dyear = (double) *year; + dj0 = dt2jd (dyear+0.0101, 0.0); + *doy = dj - dj0 + 1.0; + return; +} + + +/* TS2JD-- convert seconds since 1950.0 to Julian date */ + +double +ts2jd (tsec) + +double tsec; /* seconds since 1950.0 */ +{ + return (2433282.5 + (tsec / 86400.0)); +} + + +/* TS2MJD-- convert seconds since 1950.0 to modified Julian date */ + +double +ts2mjd (tsec) + +double tsec; /* seconds since 1950.0 */ +{ + return (33282.0 + (tsec / 86400.0)); +} + + +/* TS2EP-- convert seconds since 1950.0 to fractional year as used in epoch */ + +double +ts2ep (tsec) + +double tsec; /* Seconds since 1950.0 */ + +{ + double date, time; + ts2dt (tsec, &date, &time); + return (dt2ep (date, time)); +} + + +/* TS2EPB-- convert seconds since 1950.0 to Besselian epoch */ + +double +ts2epb (tsec) + +double tsec; /* Seconds since 1950.0 */ + +{ + double dj; /* Julian Date */ + dj = ts2jd (tsec); + return (jd2epb (dj)); +} + + +/* TS2EPB-- convert seconds since 1950.0 to Julian epoch */ + +double +ts2epj (tsec) + +double tsec; /* Seconds since 1950.0 */ + +{ + double dj; /* Julian Date */ + dj = ts2jd (tsec); + return (jd2epj (dj)); +} + + +/* DT2EP-- convert from date, time as yyyy.mmdd hh.mmsss to fractional year */ + +double +dt2ep (date, time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double epoch; /* Date as fractional year (returned) */ + double dj, dj0, dj1, date0, time0, date1; + + dj = dt2jd (date, time); + if (date == 0.0) + epoch = dj / 365.2422; + else { + time0 = 0.0; + date0 = dint (date) + 0.0101; + date1 = dint (date) + 1.0101; + dj0 = dt2jd (date0, time0); + dj1 = dt2jd (date1, time0); + epoch = dint (date) + ((dj - dj0) / (dj1 - dj0)); + } + return (epoch); +} + + +/* DT2EPB-- convert from date, time as yyyy.mmdd hh.mmsss to Besselian epoch */ + +double +dt2epb (date, time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Julian date */ + double epoch; /* Date as fractional year (returned) */ + dj = dt2jd (date, time); + if (date == 0.0) + epoch = dj / 365.242198781; + else + epoch = jd2epb (dj); + return (epoch); +} + + +/* DT2EPJ-- convert from date, time as yyyy.mmdd hh.mmsss to Julian epoch */ + +double +dt2epj (date, time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Julian date */ + double epoch; /* Date as fractional year (returned) */ + dj = dt2jd (date, time); + if (date == 0.0) + epoch = dj / 365.25; + else + epoch = jd2epj (dj); + return (epoch); +} + + +/* EP2DT-- convert from fractional year to date, time as yyyy.mmdd hh.mmsss */ + +void +ep2dt (epoch, date, time) + +double epoch; /* Date as fractional year */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj, dj0, dj1, date0, time0, date1, epochi, epochf; + + time0 = 0.0; + epochi = dint (epoch); + epochf = epoch - epochi; + date0 = epochi + 0.0101; + date1 = epochi + 1.0101; + dj0 = dt2jd (date0, time0); + dj1 = dt2jd (date1, time0); + dj = dj0 + epochf * (dj1 - dj0); + jd2dt (dj, date, time); + return; +} + + +/* EPB2DT-- convert from Besselian epoch to date, time as yyyy.mmdd hh.mmsss */ + +void +epb2dt (epoch, date, time) + +double epoch; /* Besselian epoch (fractional 365.242198781-day years) */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Julian date */ + dj = epb2jd (epoch); + jd2dt (dj, date, time); +} + + +/* EPJ2DT-- convert from Julian epoch to date, time as yyyy.mmdd hh.mmsss */ + +void +epj2dt (epoch, date, time) + +double epoch; /* Julian epoch (fractional 365.25-day years) */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double dj; /* Julian date */ + dj = epj2jd (epoch); + jd2dt (dj, date, time); +} + + +/* FD2JD-- convert FITS standard date to Julian date */ + +double +fd2jd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double date, time; + + fd2dt (string, &date, &time); + return (dt2jd (date, time)); +} + + +/* FD2MJD-- convert FITS standard date to modified Julian date */ + +double +fd2mjd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + return (fd2jd (string) - 2400000.5); +} + + +/* FD2TSU-- convert from FITS date to Unix seconds since 1970-01-01T0:00 */ + +time_t +fd2tsu (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double date, time; + fd2dt (string, &date, &time); + return (dt2tsu (date, time)); +} + + +/* FD2TSI-- convert from FITS date to IRAF seconds since 1980-01-01T0:00 */ + +int +fd2tsi (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double date, time; + fd2dt (string, &date, &time); + return (dt2tsi (date, time)); +} + + +/* FD2TS-- convert FITS standard date to seconds since 1950 */ + +double +fd2ts (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double date, time; + fd2dt (string, &date, &time); + return (dt2ts (date, time)); +} + + +/* FD2FD-- convert any FITS standard date to ISO FITS standard date */ + +char * +fd2fd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double date, time; + fd2dt (string, &date, &time); + return (dt2fd (date, time)); +} + + +/* FD2OF-- convert any FITS standard date to old FITS standard date time */ + +char * +fd2of (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + fd2i (string,&iyr,&imon,&iday,&ihr,&imn,&sec, 3); + + /* Convert to old FITS date format */ + string = (char *) calloc (32, sizeof (char)); + if (iyr < 1900) + sprintf (string, "*** date out of range ***"); + else if (iyr < 2000) + sprintf (string, "%02d/%02d/%02d %02d:%02d:%06.3f", + iday, imon, iyr-1900, ihr, imn, sec); + else if (iyr < 2900.0) + sprintf (string, "%02d/%02d/%3d %02d:%02d:%6.3f", + iday, imon, iyr-1900, ihr, imn, sec); + else + sprintf (string, "*** date out of range ***"); + return (string); +} + + +/* TAI-UTC from the U.S. Naval Observatory */ +/* ftp://maia.usno.navy.mil/ser7/tai-utc.dat */ +static double taijd[26]={2441317.5, 2441499.5, 2441683.5, 2442048.5, 2442413.5, + 2442778.5, 2443144.5, 2443509.5, 2443874.5, 2444239.5, 2444786.5, + 2445151.5, 2445516.5, 2446247.5, 2447161.5, 2447892.5, 2448257.5, + 2448804.5, 2449169.5, 2449534.5, 2450083.5, 2450630.5, 2451179.5, + 2453736.5, 2454832.5, 2456293.5}; +static double taidt[26]={10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0, + 20.0,21.0,22.0,23.0,24.0,25.0,26.0,27.0,28.0,29.0,30.0,31.0,32.0, + 33.0,34.0,35.0}; +static double dttab[173]={13.7,13.4,13.1,12.9,12.7,12.6,12.5,12.5,12.5,12.5, + 12.5,12.5,12.5,12.5,12.5,12.5,12.5,12.4,12.3,12.2,12.0,11.7,11.4, + 11.1,10.6,10.2, 9.6, 9.1, 8.6, 8.0, 7.5, 7.0, 6.6, 6.3, 6.0, 5.8, + 5.7, 5.6, 5.6, 5.6, 5.7, 5.8, 5.9, 6.1, 6.2, 6.3, 6.5, 6.6, 6.8, + 6.9, 7.1, 7.2, 7.3, 7.4, 7.5, 7.6, 7.7, 7.7, 7.8, 7.8,7.88,7.82, + 7.54, 6.97, 6.40, 6.02, 5.41, 4.10, 2.92, 1.82, 1.61, 0.10,-1.02, + -1.28,-2.69,-3.24,-3.64,-4.54,-4.71,-5.11,-5.40,-5.42,-5.20,-5.46, + -5.46,-5.79,-5.63,-5.64,-5.80,-5.66,-5.87,-6.01,-6.19,-6.64,-6.44, + -6.47,-6.09,-5.76,-4.66,-3.74,-2.72,-1.54,-0.02, 1.24, 2.64, 3.86, + 5.37, 6.14, 7.75, 9.13,10.46,11.53,13.36,14.65,16.01,17.20,18.24, + 19.06,20.25,20.95,21.16,22.25,22.41,23.03,23.49,23.62,23.86,24.49, + 24.34,24.08,24.02,24.00,23.87,23.95,23.86,23.93,23.73,23.92,23.96, + 24.02,24.33,24.83,25.30,25.70,26.24,26.77,27.28,27.78,28.25,28.71, + 29.15,29.57,29.97,30.36,30.72,31.07,31.35,31.68,32.18,32.68,33.15, + 33.59,34.00,34.47,35.03,35.73,36.54,37.43,38.29,39.20,40.18,41.17, + 42.23}; + + +/* TAI2FD-- convert from TAI in FITS format to UT in FITS format */ + +char * +tai2fd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double dj0, dj, tsec, dt; + + dj0 = fd2jd (string); + dt = utdt (dj0); + dj = dj0 - (dt / 86400.0); + dt = utdt (dj); + tsec = fd2ts (string); + tsec = tsec - dt + 32.184; + return (ts2fd (tsec)); +} + + +/* FD2TAI-- convert from UT in FITS format to TAI in FITS format */ + +char * +fd2tai (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double dj, tsec, dt; + + dj = fd2jd (string); + dt = utdt (dj); + tsec = fd2ts (string); + tsec = tsec + dt - 32.184; + return (ts2fd (tsec)); +} + + +/* DT2TAI-- convert from UT as yyyy.mmdd hh.mmssss to TAI in same format */ + +void +dt2tai (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, dt, tsec; + + dj = dt2jd (*date, *time); + dt = utdt (dj); + tsec = dt2ts (*date, *time); + tsec = tsec + dt - 32.184; + ts2dt (tsec, date, time); + return; +} + + +/* TAI2DT-- convert from TAI as yyyy.mmdd hh.mmssss to UT in same format */ + +void +tai2dt (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, dt, tsec, tsec0; + + dj = dt2jd (*date, *time); + dt = utdt (dj); + tsec0 = dt2ts (*date, *time); + tsec = tsec0 + dt; + dj = ts2jd (tsec); + dt = utdt (dj); + tsec = tsec0 + dt + 32.184; + ts2dt (tsec, date, time); + return; +} + + +/* ET2FD-- convert from ET (or TDT or TT) in FITS format to UT in FITS format */ + +char * +et2fd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double dj0, dj, tsec, dt; + + dj0 = fd2jd (string); + dt = utdt (dj0); + dj = dj0 - (dt / 86400.0); + dt = utdt (dj); + tsec = fd2ts (string); + tsec = tsec - dt; + return (ts2fd (tsec)); +} + + +/* FD2ET-- convert from UT in FITS format to ET (or TDT or TT) in FITS format */ + +char * +fd2et (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double dj, tsec, dt; + + dj = fd2jd (string); + dt = utdt (dj); + tsec = fd2ts (string); + tsec = tsec + dt; + return (ts2fd (tsec)); +} + + +/* DT2ET-- convert from UT as yyyy.mmdd hh.mmssss to ET in same format */ + +void +dt2et (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, dt, tsec; + + dj = dt2jd (*date, *time); + dt = utdt (dj); + tsec = dt2ts (*date, *time); + tsec = tsec + dt; + ts2dt (tsec, date, time); + return; +} + + +/* EDT2DT-- convert from ET as yyyy.mmdd hh.mmssss to UT in same format */ + +void +edt2dt (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, dt, tsec, tsec0; + + dj = dt2jd (*date, *time); + dt = utdt (dj); + tsec0 = dt2ts (*date, *time); + tsec = tsec0 + dt; + dj = ts2jd (tsec); + dt = utdt (dj); + tsec = tsec0 + dt; + ts2dt (tsec, date, time); + return; +} + + +/* JD2JED-- convert from Julian Date to Julian Ephemeris Date */ + +double +jd2jed (dj) + +double dj; /* Julian Date */ +{ + double dt; + + dt = utdt (dj); + return (dj + (dt / 86400.0)); +} + + +/* JED2JD-- convert from Julian Ephemeris Date to Julian Date */ + +double +jed2jd (dj) + +double dj; /* Julian Ephemeris Date */ +{ + double dj0, dt; + + dj0 = dj; + dt = utdt (dj); + dj = dj0 - (dt / 86400.0); + dt = utdt (dj); + return (dj - (dt / 86400.0)); +} + + +/* TS2ETS-- convert from UT in seconds since 1950-01-01 to ET in same format */ + +double +ts2ets (tsec) + +double tsec; +{ + double dj, dt; + + dj = ts2jd (tsec); + dt = utdt (dj); + return (tsec + dt); +} + + +/* ETS2TS-- convert from ET in seconds since 1950-01-01 to UT in same format */ + +double +ets2ts (tsec) + +double tsec; +{ + double dj, dj0, dt; + + dj0 = ts2jd (tsec); + dt = utdt (dj0); + dj = dj0 - (dt / 86400.0); + dt = utdt (dj); + return (tsec - dt); +} + + +/* UTDT-- Compute difference between UT and dynamical time (ET-UT) */ + +double +utdt (dj) + +double dj; /* Julian Date (UT) */ +{ + double dt, date, time, ts, ts1, ts0, date0, yfrac, diff, cj; + int i, iyr, iyear; + + /* If after 1972-01-01, use tabulated TAI-UT */ + if (dj >= 2441317.5) { + dt = 0.0; + for (i = 22; i > 0; i--) { + if (dj >= taijd[i]) + dt = taidt[i]; + } + dt = dt + 32.184; + } + + /* For 1800-01-01 to 1972-01-01, use table of ET-UT from AE */ + else if (dj >= 2378496.5) { + jd2dt (dj, &date, &time); + ts = jd2ts (dj); + iyear = (int) date; + iyr = iyear - 1800; + date0 = (double) iyear + 0.0101; + ts0 = dt2ts (date0, 0.0); + date0 = (double) (iyear + 1) + 0.0101; + ts1 = dt2ts (date0, 0.0); + yfrac = (ts - ts0) / (ts1 - ts0); + diff = dttab[iyr+1] - dttab[iyr]; + dt = dttab[iyr] + (diff * yfrac); + } + + /* Compute back to 1600 using formula from McCarthy and Babcock (1986) */ + else if (dj >= 2305447.5) { + cj = (dj - 2378496.5) / 36525.0; + dt = 5.156 + 13.3066 * (cj - 0.19) * (cj - 0.19); + } + + /* Compute back to 948 using formula from Stephenson and Morrison (1984) */ + else if (dj >= 2067309.5) { + cj = (dj - 2378496.5) / 36525.0; + dt = 25.5 * cj * cj; + } + + /*Compute back to 390 BC using formula from Stephenson and Morrison (1984)*/ + else if (dj >= 0.0) { + cj = (dj = 2378496.5) / 36525.0; + dt = 1360.0 + (320.0 * cj) + (44.3 * cj * cj); + } + + else + dt = 0.0; + return (dt); +} + + +/* FD2OFD-- convert any FITS standard date to old FITS standard date */ + +char * +fd2ofd (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + fd2i (string,&iyr,&imon,&iday,&ihr,&imn,&sec, 3); + + /* Convert to old FITS date format */ + string = (char *) calloc (32, sizeof (char)); + if (iyr < 1900) + sprintf (string, "*** date out of range ***"); + else if (iyr < 2000) + sprintf (string, "%02d/%02d/%02d", iday, imon, iyr-1900); + else if (iyr < 2900.0) + sprintf (string, "%02d/%02d/%3d", iday, imon, iyr-1900); + else + sprintf (string, "*** date out of range ***"); + return (string); +} + + +/* FD2OFT-- convert any FITS standard date to old FITS standard time */ + +char * +fd2oft (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + fd2i (string,&iyr,&imon,&iday,&ihr,&imn,&sec, 3); + + /* Convert to old FITS date format */ + string = (char *) calloc (32, sizeof (char)); + sprintf (string, "%02d:%02d:%06.3f", ihr, imn, sec); + return (string); +} + + +/* FD2DT-- convert FITS standard date to date, time as yyyy.mmdd hh.mmsss */ + +void +fd2dt (string, date, time) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + fd2i (string,&iyr,&imon,&iday,&ihr,&imn,&sec, 4); + + /* Convert date to yyyy.mmdd */ + if (iyr < 0) { + *date = (double) (-iyr) + 0.01 * (double) imon + 0.0001 * (double) iday; + *date = -(*date); + } + else + *date = (double) iyr + 0.01 * (double) imon + 0.0001 * (double) iday; + + /* Convert time to hh.mmssssss */ + *time = (double) ihr + 0.01 * (double) imn + 0.0001 * sec; + + return; +} + + +/* FD2EP-- convert from FITS standard date to fractional year */ + +double +fd2ep (string) + +char *string; /* FITS date string, which may be: + yyyy.ffff (fractional year) + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + +{ + double dj; /* Julian date */ + dj = fd2jd (string); + if (dj < 1.0) + return (dj / 365.2422); + else + return (jd2ep (dj)); +} + + +/* FD2EPB-- convert from FITS standard date to Besselian epoch */ + +double +fd2epb (string) + +char *string; /* FITS date string, which may be: + yyyy.ffff (fractional year) + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + +{ + double dj; /* Julian date */ + dj = fd2jd (string); + if (dj < 1.0) + return (dj / 365.242198781); + else + return (jd2epb (dj)); +} + + +/* FD2EPJ-- convert from FITS standard date to Julian epoch */ + +double +fd2epj (string) + +char *string; /* FITS date string, which may be: + yyyy.ffff (fractional year) + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + +{ + double dj; /* Julian date */ + dj = fd2jd (string); + if (dj < 1.0) + return (dj / 365.25); + else + return (jd2epj (dj)); +} + + +/* DT2TSU-- convert from date and time to Unix seconds since 1970-01-01T0:00 */ + +time_t +dt2tsu (date,time) + +double date; /* Date as yyyy.mmdd */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + return ((time_t)(dt2ts (date, time) - 631152000.0)); +} + + +/* DT2TSI-- convert from date and time to IRAF seconds since 1980-01-01T0:00 */ + +int +dt2tsi (date,time) + +double date; /* Date as yyyy.mmdd */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + return ((int)(dt2ts (date, time) - 946684800.0)); +} + + + +/* DT2TS-- convert from date, time as yyyy.mmdd hh.mmsss to sec since 1950.0 */ + +double +dt2ts (date,time) + +double date; /* Date as yyyy.mmdd + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + double tsec; /* Seconds past 1950.0 (returned) */ + + double dh,dm,dd; + int iy,im,id; + +/* Calculate the number of full years, months, and days already + * elapsed since 0h, March 1, -1 (up to most recent midnight). */ + + /* convert time of day to elapsed seconds */ + + /* If time is < 0, it is assumed to be a fractional day */ + if (time < 0.0) + tsec = time * -86400.0; + else { + dh = (int) (time + 0.0000000001); + dm = (int) (((time - dh) * 100.0) + 0.0000000001); + tsec = (time * 10000.0) - (dh * 10000.0) - (dm * 100.0); + tsec = (int) (tsec * 100000.0 + 0.0001) / 100000.0; + tsec = tsec + (dm * 60.0) + (dh * 3600.0); + } + + + /* Calculate the number of full months elapsed since + * the current or most recent March */ + if (date >= 0.0301) { + iy = (int) (date + 0.0000000001); + im = (int) (((date - (double) (iy)) * 10000.0) + 0.00000001); + id = im % 100; + im = (im / 100) + 9; + if (im < 12) iy = iy - 1; + im = im % 12; + id = id - 1; + + /* starting with March as month 0 and ending with the following + * February as month 11, the calculation of the number of days + * per month reduces to a simple formula. the following statement + * determines the number of whole days elapsed since 3/1/-1 and then + * subtracts the 712163 days between then and 1/1/1950. it converts + * the result to seconds and adds the accumulated seconds above. */ + id = id + ((im+1+im/6+im/11)/2 * 31) + ((im-im/6-im/11)/2 * 30) + + (iy / 4) - (iy / 100) + (iy / 400); + dd = (double) id + (365.0 * (double) iy) - 712163.0; + tsec = tsec + (dd * 86400.0); + } + + return (tsec); +} + + +/* TS2DT-- convert seconds since 1950.0 to date, time as yyyy.mmdd hh.mmssss */ + +void +ts2dt (tsec,date,time) + +double tsec; /* Seconds past 1950.0 */ +double *date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double *time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +{ + int iyr,imon,iday,ihr,imn; + double sec; + + ts2i (tsec,&iyr,&imon,&iday,&ihr,&imn,&sec, 4); + + /* Convert date to yyyy.mmdd */ + if (iyr < 0) { + *date = (double) (-iyr) + 0.01 * (double) imon + 0.0001 * (double) iday; + *date = -(*date); + } + else + *date = (double) iyr + 0.01 * (double) imon + 0.0001 * (double) iday; + + /* Convert time to hh.mmssssss */ + *time = (double) ihr + 0.01 * (double) imn + 0.0001 * sec; + + return; +} + + +/* TSI2DT-- Convert seconds since 1980-01-01 to date yyyy.ddmm, time hh.mmsss */ + +void +tsi2dt (isec,date,time) + +int isec; /* Seconds past 1980-01-01 */ +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ +{ + ts2dt (tsi2ts (isec), date, time); +} + + +/* TSI2FD-- Convert seconds since 1980-01-01 to FITS standard date string */ + +char * +tsi2fd (isec) + +int isec; /* Seconds past 1980-01-01 */ +{ + return (ts2fd (tsi2ts (isec))); +} + + +/* TSI2TS-- Convert seconds since 1980-01-01 to seconds since 1950-01-01 */ + +double +tsi2ts (isec) +int isec; /* Seconds past 1980-01-01 */ +{ + return ((double) isec + 946684800.0); +} + + +/* TSU2FD-- Convert seconds since 1970-01-01 to FITS standard date string */ + +char * +tsu2fd (isec) +time_t isec; /* Seconds past 1970-01-01 */ +{ + return (ts2fd (tsu2ts (isec))); +} + + +/* TSU2DT-- Convert seconds since 1970-01-01 to date yyyy.ddmm, time hh.mmsss */ + +void +tsu2dt (isec,date,time) +time_t isec; /* Seconds past 1970-01-01 */ +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ +{ + ts2dt (tsu2ts (isec), date, time); +} + + +/* TSU2TS-- Convert seconds since 1970-01-01 to seconds since 1950-01-01 */ + +double +tsu2ts (isec) +time_t isec; /* Seconds past 1970-01-01 */ +{ + return ((double) isec + 631152000.0); +} + +/* TSU2TSI-- UT seconds since 1970-01-01 to local seconds since 1980-01-01 */ + +int +tsu2tsi (isec) +time_t isec; /* Seconds past 1970-01-01 */ +{ + double date, time; + struct tm *ts; + + /* Get local time from UT seconds */ + ts = localtime (&isec); + if (ts->tm_year < 1000) + date = (double) (ts->tm_year + 1900); + else + date = (double) ts->tm_year; + date = date + (0.01 * (double) (ts->tm_mon + 1)); + date = date + (0.0001 * (double) ts->tm_mday); + time = (double) ts->tm_hour; + time = time + (0.01 * (double) ts->tm_min); + time = time + (0.0001 * (double) ts->tm_sec); + return ((int)(dt2ts (date, time) - 631152000.0)); +} + + +/* TS2FD-- convert seconds since 1950.0 to FITS date, yyyy-mm-ddThh:mm:ss.ss */ + +char * +ts2fd (tsec) + +double tsec; /* Seconds past 1950.0 */ +{ + double date, time; + + ts2dt (tsec, &date, &time); + return (dt2fd (date, time)); +} + + +/* TSD2FD-- convert seconds since start of day to FITS time, hh:mm:ss.ss */ + +char * +tsd2fd (tsec) + +double tsec; /* Seconds since start of day */ +{ + double date, time; + char *thms, *fdate; + int lfd, nbc; + + ts2dt (tsec, &date, &time); + fdate = dt2fd (date, time); + thms = (char *) calloc (16, 1); + lfd = strlen (fdate); + nbc = lfd - 11; + strncpy (thms, fdate+11, nbc); + return (thms); +} + + +/* TSD2DT-- convert seconds since start of day to hh.mmssss */ + +double +tsd2dt (tsec) + +double tsec; /* Seconds since start of day */ +{ + double date, time; + + ts2dt (tsec, &date, &time); + return (time); +} + + + +/* DT2I-- convert vigesimal date and time to year month day hours min sec */ + +void +dt2i (date, time, iyr, imon, iday, ihr, imn, sec, ndsec) + +double date; /* Date as yyyy.mmdd (returned) + yyyy = calendar year (e.g. 1973) + mm = calendar month (e.g. 04 = april) + dd = calendar day (e.g. 15) */ +double time; /* Time as hh.mmssxxxx (returned) + *if time<0, it is time as -(fraction of a day) + hh = hour of day (0 .le. hh .le. 23) + nn = minutes (0 .le. nn .le. 59) + ss = seconds (0 .le. ss .le. 59) + xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ + +{ + double t,d; + + t = time; + if (date < 0.0) + d = -date; + else + d = date; + + /* Extract components of time */ + *ihr = dint (t + 0.000000001); + t = 100.0 * (t - (double) *ihr); + *imn = dint (t + 0.0000001); + *sec = 100.0 * (t - (double) *imn); + + /* Extract components of date */ + *iyr = dint (d + 0.00001); + d = 100.0 * (d - (double) *iyr); + if (date < 0.0) + *iyr = - *iyr; + *imon = dint (d + 0.001); + d = 100.0 * (d - (double) *imon); + *iday = dint (d + 0.1); + + /* Make sure date and time are legal */ + fixdate (iyr, imon, iday, ihr, imn, sec, ndsec); + + return; +} + + +/* FD2I-- convert from FITS standard date to year, mon, day, hours, min, sec */ + +void +fd2i (string, iyr, imon, iday, ihr, imn, sec, ndsec) + +char *string; /* FITS date string, which may be: + yyyy.ffff (fractional year) + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ + +{ + double tsec, fday, hr, mn; + int i; + char *sstr, *dstr, *tstr, *cstr, *nval, *fstr; + + /* Initialize all returned data to zero */ + *iyr = 0; + *imon = 0; + *iday = 0; + *ihr = 0; + *imn = 0; + *sec = 0.0; + + /* Return if no input string */ + if (string == NULL) + return; + + /* Check for various non-numeric characters */ + sstr = strchr (string,'/'); + dstr = strchr (string,'-'); + if (dstr == string) + dstr = strchr (string+1, '-'); + fstr = strchr (string, '.'); + tstr = strchr (string,'T'); + if (tstr == NULL) + tstr = strchr (string, 'Z'); + if (tstr == NULL) + tstr = strchr (string, 'S'); + if (fstr != NULL && tstr != NULL && fstr > tstr) + fstr = NULL; + cstr = strchr (string,':'); + + /* Original FITS date format: dd/mm/yy */ + if (sstr > string) { + *sstr = '\0'; + *iday = (int) atof (string); + if (*iday > 31) { + *iyr = *iday; + if (*iyr >= 0 && *iyr <= 49) + *iyr = *iyr + 2000; + else if (*iyr < 1000) + *iyr = *iyr + 1900; + *sstr = '/'; + nval = sstr + 1; + sstr = strchr (nval,'/'); + if (sstr > string) { + *sstr = '\0'; + *imon = (int) atof (nval); + *sstr = '/'; + nval = sstr + 1; + *iday = (int) atof (nval); + } + } + else { + *sstr = '/'; + nval = sstr + 1; + sstr = strchr (nval,'/'); + if (sstr == NULL) + sstr = strchr (nval,'-'); + if (sstr > string) { + *sstr = '\0'; + *imon = (int) atof (nval); + *sstr = '/'; + nval = sstr + 1; + *iyr = (int) atof (nval); + if (*iyr >= 0 && *iyr <= 49) + *iyr = *iyr + 2000; + else if (*iyr < 1000) + *iyr = *iyr + 1900; + } + } + tstr = strchr (string,'_'); + if (tstr == NULL) + return; + } + + /* New FITS date format: yyyy-mm-ddThh:mm:ss[.sss] */ + else if (dstr > string) { + *dstr = '\0'; + *iyr = (int) atof (string); + *dstr = '-'; + nval = dstr + 1; + dstr = strchr (nval,'-'); + *imon = 1; + *iday = 1; + + /* Decode year, month, and day */ + if (dstr > string) { + *dstr = '\0'; + *imon = (int) atof (nval); + *dstr = '-'; + nval = dstr + 1; + if (tstr > string) + *tstr = '\0'; + *iday = (int) atof (nval); + + /* If fraction of a day is present, turn it into a time */ + if (fstr != NULL) { + fday = atof (fstr); + hr = fday * 24.0; + *ihr = (int) hr; + mn = 60.0 * (hr - (double) *ihr); + *imn = (int) mn; + *sec = 60.0 * (mn - (double) *imn); + } + + if (tstr > string) + *tstr = 'T'; + } + + /* If date is > 31, it is really year in old format */ + if (*iday > 31) { + i = *iyr; + if (*iday < 100) + *iyr = *iday + 1900; + else + *iyr = *iday; + *iday = i; + } + } + + /* In rare cases, a FITS time is entered as an epoch */ + else if (tstr == NULL && cstr == NULL && isnum (string)) { + tsec = ep2ts (atof (string)); + ts2i (tsec,iyr,imon,iday,ihr,imn,sec, ndsec); + return; + } + + /* Extract time, if it is present */ + if (tstr > string || cstr > string) { + if (tstr > string) + nval = tstr + 1; + else + nval = string; + cstr = strchr (nval,':'); + if (cstr > string) { + *cstr = '\0'; + *ihr = (int) atof (nval); + *cstr = ':'; + nval = cstr + 1; + cstr = strchr (nval,':'); + if (cstr > string) { + *cstr = '\0'; + *imn = (int) atof (nval); + *cstr = ':'; + nval = cstr + 1; + *sec = atof (nval); + } + else + *imn = (int) atof (nval); + } + else + *ihr = (int) atof (nval); + } + else + ndsec = -1; + + /* Make sure date and time are legal */ + fixdate (iyr, imon, iday, ihr, imn, sec, ndsec); + + return; +} + + +/* TS2I-- convert sec since 1950.0 to year month day hours minutes seconds */ + +void +ts2i (tsec,iyr,imon,iday,ihr,imn,sec, ndsec) + +double tsec; /* seconds since 1/1/1950 0:00 */ +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ + +{ + double t,days, ts, dts; + int nc,nc4,nly,ny,m,im; + + /* Round seconds to 0 - 4 decimal places */ + ts = tsec + 61530883200.0; + if (ts < 0.0) + dts = -0.5; + else + dts = 0.5; + if (ndsec < 1) + t = dint (ts + dts) * 10000.0; + else if (ndsec < 2) + t = dint (ts * 10.0 + dts) * 1000.0; + else if (ndsec < 3) + t = dint (ts * 100.0 + dts) * 100.0; + else if (ndsec < 4) + t = dint (ts * 1000.0 + dts) * 10.0; + else + t = dint (ts * 10000.0 + dts); + ts = t / 10000.0; + + /* Time of day (hours, minutes, seconds */ + *ihr = (int) (dmod (ts/3600.0, 24.0)); + *imn = (int) (dmod (ts/60.0, 60.0)); + *sec = dmod (ts, 60.0); + + /* Number of days since 0 hr 0/0/0000 */ + days = dint ((t / 864000000.0) + 0.000001); + + /* Number of leap centuries (400 years) */ + nc4 = (int) ((days / 146097.0) + 0.00001); + + /* Number of centuries since last /400 */ + days = days - (146097.0 * (double) (nc4)); + nc = (int) ((days / 36524.0) + 0.000001); + if (nc > 3) nc = 3; + + /* Number of leap years since last century */ + days = days - (36524.0 * nc); + nly = (int) ((days / 1461.0) + 0.0000000001); + + /* Number of years since last leap year */ + days = days - (1461.0 * (double) nly); + ny = (int) ((days / 365.0) + 0.00000001); + if (ny > 3) ny = 3; + + /* Day of month */ + days = days - (365.0 * (double) ny); + if (days < 0) { + m = 0; + *iday = 29; + } + else { + *iday = (int) (days + 0.00000001) + 1; + for (m = 1; m <= 12; m++) { + im = (m + ((m - 1) / 5)) % 2; + /* fprintf (stderr,"%d %d %d %d\n", m, im, *iday, nc); */ + if (*iday-1 < im+30) break; + *iday = *iday - im - 30; + } + } + + /* Month */ + *imon = ((m+1) % 12) + 1; + + /* Year */ + *iyr = nc4*400 + nc*100 + nly*4 + ny + m/11; + + /* Make sure date and time are legal */ + fixdate (iyr, imon, iday, ihr, imn, sec, ndsec); + + return; +} + + +/* UT2DOY-- Current Universal Time as year, day of year */ + +void +ut2doy (year, doy) + +int *year; /* Year (returned) */ +double *doy; /* Day of year (returned) */ +{ + double date, time; + ut2dt (&date, &time); + dt2doy (date, time, year, doy); + return; +} + + +/* UT2DT-- Current Universal Time as date (yyyy.mmdd) and time (hh.mmsss) */ + +void +ut2dt(date, time) + +double *date; /* Date as yyyy.mmdd (returned) */ +double *time; /* Time as hh.mmssxxxx (returned) */ +{ + time_t tsec; + struct timeval tp; + struct timezone tzp; + struct tm *ts; + + gettimeofday (&tp,&tzp); + + tsec = tp.tv_sec; + ts = gmtime (&tsec); + + if (ts->tm_year < 1000) + *date = (double) (ts->tm_year + 1900); + else + *date = (double) ts->tm_year; + *date = *date + (0.01 * (double) (ts->tm_mon + 1)); + *date = *date + (0.0001 * (double) ts->tm_mday); + *time = (double) ts->tm_hour; + *time = *time + (0.01 * (double) ts->tm_min); + *time = *time + (0.0001 * (double) ts->tm_sec); + + return; +} + + +/* UT2EP-- Return current Universal Time as fractional year */ + +double +ut2ep() +{ + return (jd2ep (ut2jd())); +} + + +/* UT2EPB-- Return current Universal Time as Besselian epoch */ + +double +ut2epb() +{ + return (jd2epb (ut2jd())); +} + + +/* UT2EPJ-- Return current Universal Time as Julian epoch */ + +double +ut2epj() +{ + return (jd2epj (ut2jd())); +} + + +/* UT2FD-- Return current Universal Time as FITS ISO date string */ + +char * +ut2fd() +{ + int year, month, day, hour, minute, second; + time_t tsec; + struct timeval tp; + struct timezone tzp; + struct tm *ts; + char *isotime; + + gettimeofday (&tp,&tzp); + tsec = tp.tv_sec; + ts = gmtime (&tsec); + + year = ts->tm_year; + if (year < 1000) + year = year + 1900; + month = ts->tm_mon + 1; + day = ts->tm_mday; + hour = ts->tm_hour; + minute = ts->tm_min; + second = ts->tm_sec; + + isotime = (char *) calloc (32, sizeof (char)); + sprintf (isotime, "%04d-%02d-%02dT%02d:%02d:%02d", + year, month, day, hour, minute, second); + return (isotime); +} + + +/* UT2JD-- Return current Universal Time as Julian Date */ + +double +ut2jd() +{ + return (fd2jd (ut2fd())); +} + + +/* UT2MJD-- convert current UT to Modified Julian Date */ + +double +ut2mjd () + +{ + return (ut2jd() - 2400000.5); +} + +/* UT2TS-- current Universal Time as IRAF seconds since 1950-01-01T00:00 */ + +double +ut2ts() +{ + double tsec; + char *datestring; + datestring = ut2fd(); + tsec = fd2ts (datestring); + free (datestring); + return (tsec); +} + + +/* UT2TSI-- current Universal Time as IRAF seconds since 1980-01-01T00:00 */ + +int +ut2tsi() +{ + return ((int)(ut2ts() - 946684800.0)); +} + + +/* UT2TSU-- current Universal Time as IRAF seconds since 1970-01-01T00:00 */ + +time_t +ut2tsu() +{ + return ((time_t)(ut2ts () - 631152000.0)); +} + + +/* FD2GST-- convert from FITS date to Greenwich Sidereal Time */ + +char * +fd2gst (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double dj, gsec, date, time; + + dj = fd2jd (string); + gsec = jd2gst (dj); + ts2dt (gsec, &date, &time); + date = 0.0; + return (dt2fd (date, time)); +} + + +/* DT2GST-- convert from UT as yyyy.mmdd hh.mmssss to Greenwich Sidereal Time*/ + +void +dt2gst (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, gsec; + + dj = dt2ts (*date, *time); + gsec = jd2gst (dj); + ts2dt (gsec, date, time); + *date = 0.0; + return; +} + + +/* JD2LST - Local Sidereal Time in seconds from Julian Date */ + +double +jd2lst (dj) + +double dj; /* Julian Date */ +{ + double gst, lst; + + /* Compute Greenwich Sidereal Time at this epoch */ + gst = jd2gst (dj); + + /* Subtract longitude (degrees to seconds of time) */ + lst = gst - (240.0 * longitude); + if (lst < 0.0) + lst = lst + 86400.0; + else if (lst > 86400.0) + lst = lst - 86400.0; + return (lst); +} + + +/* FD2LST - Local Sidereal Time as hh:mm:ss.ss + from Universal Time as FITS ISO date */ + +char * +fd2lst (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) */ +{ + double dj, date, time, lst; + + dj = fd2jd (string); + lst = jd2lst (dj); + ts2dt (lst, &date, &time); + date = 0.0; + return (dt2fd (date, time)); +} + + +/* DT2LST - Local Sidereal Time as hh.mmssss + from Universal Time as yyyy.mmdd hh.mmssss */ + +void +dt2lst (date, time) + +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double dj, lst, date0; + + dj = dt2jd (*date, *time); + lst = jd2lst (dj); + date0 = 0.0; + ts2dt (lst, &date0, time); + return; +} + + +/* TS2LST - Local Sidereal Time in seconds of day + * from Universal Time in seconds since 1951-01-01T0:00:00 + */ + +double +ts2lst (tsec) + +double tsec; /* time since 1950.0 in UT seconds */ +{ + double gst; /* Greenwich Sidereal Time in seconds since 0:00 */ + double lst; /* Local Sidereal Time in seconds since 0:00 */ + double gsec, date; + + /* Greenwich Sidereal Time */ + gsec = ts2gst (tsec); + date = 0.0; + ts2dt (gsec, &date, &gst); + + lst = gst - (longitude / 15.0); + if (lst < 0.0) + lst = lst + 86400.0; + else if (lst > 86400.0) + lst = lst - 86400.0; + return (lst); +} + + +/* LST2FD - calculate current UT given Local Sidereal Time + * plus date in FITS ISO format (yyyy-mm-dd) + * Return UT date and time in FITS ISO format + */ + +char * +lst2fd (string) + +char *string; /* UT Date, LST as yyyy-mm-ddShh:mm:ss.ss */ +{ + double sdj, dj; + + sdj = fd2jd (string); + + dj = lst2jd (sdj); + + return (jd2fd (dj)); +} + + +/* LST2JD - calculate current Julian Date given Local Sidereal Time + * plus current Julian Date (0.5 at 0:00 UT) + * Return UT date and time as Julian Date + */ + +double +lst2jd (sdj) + +double sdj; /* Julian Date of desired day at 0:00 UT + sidereal time */ +{ + double gst; /* Greenwich Sidereal Time in seconds since 0:00 */ + double lsd; /* Local Sidereal Time in seconds since 0:00 */ + double gst0, tsd, dj1, dj0, eqnx; + int idj; + + /* Julian date at 0:00 UT */ + idj = (int) sdj; + dj0 = (double) idj + 0.5; + if (dj0 > sdj) dj0 = dj0 - 1.0; + + /* Greenwich Sidereal Time at 0:00 UT in seconds */ + gst0 = jd2gst (dj0); + + /* Sidereal seconds since 0:00 */ + lsd = (sdj - dj0) * 86400.0; + + /* Remove longitude for current Greenwich Sidereal Time in seconds */ + /* (convert longitude from degrees to seconds of time) */ + gst = lsd + (longitude * 240.0); + + /* Time since 0:00 UT */ + tsd = (gst - gst0) / 1.0027379093; + + /* Julian Date (UT) */ + dj1 = dj0 + (tsd / 86400.0); + + /* Equation of the equinoxes converted to UT seconds */ + eqnx = eqeqnx (dj1) / 1.002739093; + + /* Remove equation of equinoxes */ + dj1 = dj1 - (eqnx / 86400.0); + if (dj1 < dj0) + dj1 = dj1 + 1.0; + + return (dj1); +} + + +/* MST2FD - calculate current UT given Greenwich Mean Sidereal Time + * plus date in FITS ISO format (yyyy-mm-ddShh:mm:ss.ss) + * Return UT date and time in FITS ISO format + */ + +char * +mst2fd (string) + +char *string; /* UT Date, MST as yyyy-mm-ddShh:mm:ss.ss */ +{ + double sdj, dj; + + sdj = fd2jd (string); + + dj = mst2jd (sdj); + + return (jd2fd (dj)); +} + + +/* MST2JD - calculate current UT given Greenwich Mean Sidereal Time + * plus date in Julian Date (0:00 UT + Mean Sidereal Time) + * Return UT date and time as Julian Date + */ + +double +mst2jd (sdj) + +double sdj; /* UT Date, MST as Julian Date */ +{ + double tsd, djd, st0, dj0, dj; + + dj0 = (double) ((int) sdj) + 0.5; + + /* Greenwich Mean Sidereal Time at 0:00 UT in seconds */ + st0 = jd2mst (dj0); + + /* Mean Sidereal Time in seconds */ + tsd = (sdj - dj0) * 86400.0; + if (tsd < 0.0) + tsd = tsd + 86400.0; + + /* Convert to fraction of a day since 0:00 UT */ + djd = ((tsd - st0) / 1.0027379093) / 86400.0; + + /* Julian Date */ + dj = dj0 + djd; + if (dj < dj0) + dj = dj + (1.0 / 1.0027379093); + + return (dj); +} + + + +/* GST2FD - calculate current UT given Greenwich Sidereal Time + * plus date in FITS ISO format (yyyy-mm-ddShh:mm:ss.ss) + * Return UT date and time in FITS ISO format + */ + +char * +gst2fd (string) + +char *string; /* UT Date, GST as yyyy-mm-ddShh:mm:ss.ss */ +{ + double sdj, dj; + + sdj = fd2jd (string); + + dj = gst2jd (sdj); + + return (jd2fd (dj)); +} + + +/* GST2JD - calculate current UT given Greenwich Sidereal Time + * plus date as Julian Date (JD at 0:00 UT + sidereal time) + * Return UT date and time as Julian Date + */ + +double +gst2jd (sdj) + +double sdj; /* UT Date, GST as Julian Date */ +{ + double dj, tsd, djd, st0, dj0, eqnx; + + dj0 = (double) ((int) sdj) + 0.5; + + /* Greenwich Mean Sidereal Time at 0:00 UT in seconds */ + st0 = jd2mst (dj0); + + /* Mean Sidereal Time in seconds */ + tsd = (sdj - dj0) * 86400.0; + if (tsd < 0.0) + tsd = tsd + 86400.0; + + /* Convert to fraction of a day since 0:00 UT */ + djd = ((tsd - st0) / 1.0027379093) / 86400.0; + + /* Julian Date */ + dj = dj0 + djd; + + /* Equation of the equinoxes (converted to UT seconds) */ + eqnx = eqeqnx (dj) / 1.002737909; + + dj = dj - eqnx / 86400.0; + if (dj < dj0) + dj = dj + 1.0; + + return (dj); +} + + +/* LST2DT - calculate current UT given Local Sidereal Time as hh.mmsss + * plus date as yyyy.mmdd + * Return UT time as hh.mmssss + */ + +double +lst2dt (date0, time0) + +double date0; /* UT date as yyyy.mmdd */ +double time0; /* LST as hh.mmssss */ +{ + double gst; /* Greenwich Sidereal Time in seconds since 0:00 */ + double lst; /* Local Sidereal Time in seconds since 0:00 */ + double date1; /* UT date as yyyy.mmdd */ + double time1; /* UT as hh.mmssss */ + double tsec0, gst0, tsd, tsec; + + /* Greenwich Sidereal Time at 0:00 UT */ + tsec0 = dt2ts (date0, 0.0); + gst0 = ts2gst (tsec0); + + /* Current Greenwich Sidereal Time in seconds */ + /* (convert longitude from degrees to seconds of time) */ + lst = dt2ts (0.0, time0); + gst = lst + (longitude * 240.0); + + /* Time since 0:00 UT */ + tsd = (gst - gst0) / 1.0027379093; + + /* UT date and time */ + tsec = tsec0 + tsd; + ts2dt (tsec, &date1, &time1); + + return (time1); +} + + +/* TS2GST - calculate Greenwich Sidereal Time given Universal Time + * in seconds since 1951-01-01T0:00:00 + * Return sidereal time of day in seconds + */ + +double +ts2gst (tsec) + +double tsec; /* time since 1950.0 in UT seconds */ +{ + double gst; /* Greenwich Sidereal Time in seconds since 0:00 */ + double tsd, eqnx, dj; + int its; + + /* Elapsed time as of 0:00 UT */ + if (tsec >= 0.0) { + its = (int) (tsec + 0.5); + tsd = (double) (its % 86400); + } + else { + its = (int) (-tsec + 0.5); + tsd = (double) (86400 - (its % 86400)); + } + + /* Mean sidereal time */ + gst = ts2mst (tsec); + + /* Equation of the equinoxes */ + dj = ts2jd (tsec); + eqnx = eqeqnx (dj); + + /* Apparent sidereal time at 0:00 ut */ + gst = gst + eqnx; + + /* Current sidereal time */ + gst = gst + (tsd * 1.0027379093); + gst = dmod (gst,86400.0); + + return (gst); +} + + +/* FD2MST-- convert from FITS date Mean Sidereal Time */ + +char * +fd2mst (string) + +char *string; /* FITS date string, which may be: + fractional year + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ +{ + double gsec, date, time, dj; + + dj = fd2jd (string); + gsec = jd2mst (dj); + ts2dt (gsec, &date, &time); + date = 0.0; + return (dt2fd (date, time)); +} + + +/* DT2MST-- convert from UT as yyyy.mmdd hh.mmssss to Mean Sidereal Time + in the same format */ + +void +dt2mst (date, time) +double *date; /* Date as yyyy.mmdd */ +double *time; /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ +{ + double date0, gsec, dj; + date0 = *date; + dj = dt2jd (*date, *time); + gsec = jd2mst (dj); + ts2dt (gsec, date, time); + *date = date0; + return; +} + + +/* TS2MST - calculate Greenwich Mean Sidereal Time given Universal Time + * in seconds since 1951-01-01T0:00:00 + */ + +double +ts2mst (tsec) + +double tsec; /* time since 1950.0 in UT seconds */ +{ + double dj; + + dj = ts2jd (tsec); + return (jd2mst (dj)); +} + + +/* JD2MST - Julian Date to Greenwich Mean Sidereal Time using IAU 2000 + * Return sideral time in seconds of time + * (from USNO NOVAS package + * http://aa.usno.navy.mil/software/novas/novas_info.html + */ + +double +jd2mst2 (dj) + +double dj; /* Julian Date */ +{ + double dt, t, t2, t3, mst, st; + + dt = dj - 2451545.0; + t = dt / 36525.0; + t2 = t * t; + t3 = t2 * t; + + /* Compute Greenwich Mean Sidereal Time in seconds */ + st = (8640184.812866 * t) + (3155760000.0 * t) - (0.0000062 * t3) + + (0.093104 * t2) + 67310.54841; + + mst = dmod (st, 86400.0); + if (mst < 0.0) + mst = mst + 86400.0; + return (mst); +} + + +/* MJD2MST - Modified Julian Date to Greenwich Mean Sidereal Time using IAU 2000 + * Return sideral time in seconds of time + * (from USNO NOVAS package + * http://aa.usno.navy.mil/software/novas/novas_info.html + */ + +double +mjd2mst (dj) + +double dj; /* Modified Julian Date */ +{ + double dt, t, t2, t3, mst, st; + + dt = dj - 51544.5; + t = dt / 36525.0; + t2 = t * t; + t3 = t2 * t; + + /* Compute Greenwich Mean Sidereal Time in seconds */ + st = (8640184.812866 * t) + (3155760000.0 * t) - (0.0000062 * t3) + + (0.093104 * t2) + 67310.54841; + + mst = dmod (st, 86400.0); + if (mst < 0.0) + mst = mst + 86400.0; + return (mst); +} + + +/* JD2GST - Julian Date to Greenwich Sideral Time + * Return sideral time in seconds of time + * (Jean Meeus, Astronomical Algorithms, Willmann-Bell, 1991, pp 83-84) + */ + +double +jd2gst (dj) + +double dj; /* Julian Date */ +{ + double dj0, gmt, gst, tsd, eqnx, ssd, l0; + double ts2ss = 1.00273790935; + int ijd; + + /* Julian date at 0:00 UT */ + ijd = (int) dj; + dj0 = (double) ijd + 0.5; + if (dj0 > dj) dj0 = dj0 - 1.0; + + /* Greenwich mean sidereal time at 0:00 UT in seconds */ + l0 = longitude; + longitude = 0.0; + gmt = jd2mst (dj0); + longitude = l0; + + /* Equation of the equinoxes */ + eqnx = eqeqnx (dj); + + /* Apparent sidereal time at 0:00 ut */ + gst = gmt + eqnx; + + /* UT seconds since 0:00 */ + tsd = (dj - dj0) * 86400.0; + ssd = tsd * ts2ss; + + /* Current sidereal time */ + gst = gst + ssd; + gst = dmod (gst, 86400.0); + + return (gst); +} + + +/* EQEQNX - Compute equation of the equinoxes for apparent sidereal time */ + +double +eqeqnx (dj) + +double dj; /* Julian Date */ + +{ + double dt, edj, dpsi, deps, obl, eqnx; + double rad2tsec = 13750.98708; + + /* Convert UT to Ephemeris Time (TDB or TT)*/ + dt = utdt (dj); + edj = dj + dt / 86400.0; + + /* Nutation and obliquity */ + compnut (edj, &dpsi, &deps, &obl); + + /* Correct obliquity for nutation */ + obl = obl + deps; + + /* Equation of the equinoxes in seconds */ + eqnx = (dpsi * cos (obl)) * rad2tsec; + + return (eqnx); +} + + + +/* JD2MST - Julian Date to Mean Sideral Time + * Return sideral time in seconds of time + * (Jean Meeus, Astronomical Algorithms, Willmann-Bell, 1991, pp 83-84) + */ + +double +jd2mst (dj) + +double dj; /* Julian Date */ +{ + double dt, t, mst; + + dt = dj - 2451545.0; + t = dt / 36525.0; + + /* Compute Greenwich mean sidereal time in degrees (Meeus, page 84) */ + mst = 280.46061837 + (360.98564736629 * dt) + (0.000387933 * t * t) - + (t * t * t / 38710000.0); + + /* Keep degrees between 0 and 360 */ + while (mst > 360.0) + mst = mst - 360.0; + while (mst < 0.0) + mst = mst + 360.0; + + /* Convert to time in seconds (3600 / 15) */ + mst = mst * 240.0; + + /* Subtract longitude (degrees to seconds of time) */ + mst = mst - (240.0 * longitude); + if (mst < 0.0) + mst = mst + 86400.0; + else if (mst > 86400.0) + mst = mst - 86400.0; + + return (mst); +} + + +/* COMPNUT - Compute nutation using the IAU 2000b model */ +/* Translated from Pat Wallace's Fortran subroutine iau_nut00b (June 26 2007) + into C by Jessica Mink on September 5, 2008 */ + +#define NLS 77 /* number of terms in the luni-solar nutation model */ + +void +compnut (dj, dpsi, deps, eps0) + +double dj; /* Julian Date */ +double *dpsi; /* Nutation in longitude in radians (returned) */ +double *deps; /* Nutation in obliquity in radians (returned) */ +double *eps0; /* Mean obliquity in radians (returned) */ + +/* This routine is translated from the International Astronomical Union's + * Fortran SOFA (Standards Of Fundamental Astronomy) software collection. + * + * notes: + * + * 1) the nutation components in longitude and obliquity are in radians + * and with respect to the equinox and ecliptic of date. the + * obliquity at j2000 is assumed to be the lieske et al. (1977) value + * of 84381.448 arcsec. (the errors that result from using this + * routine with the iau 2006 value of 84381.406 arcsec can be + * neglected.) + * + * the nutation model consists only of luni-solar terms, but includes + * also a fixed offset which compensates for certain long-period + * planetary terms (note 7). + * + * 2) this routine is an implementation of the iau 2000b abridged + * nutation model formally adopted by the iau general assembly in + * 2000. the routine computes the mhb_2000_short luni-solar nutation + * series (luzum 2001), but without the associated corrections for + * the precession rate adjustments and the offset between the gcrs + * and j2000 mean poles. + * + * 3) the full IAU 2000a (mhb2000) nutation model contains nearly 1400 + * terms. the IAU 2000b model (mccarthy & luzum 2003) contains only + * 77 terms, plus additional simplifications, yet still delivers + * results of 1 mas accuracy at present epochs. this combination of + * accuracy and size makes the IAU 2000b abridged nutation model + * suitable for most practical applications. + * + * the routine delivers a pole accurate to 1 mas from 1900 to 2100 + * (usually better than 1 mas, very occasionally just outside 1 mas). + * the full IAU 2000a model, which is implemented in the routine + * iau_nut00a (q.v.), delivers considerably greater accuracy at + * current epochs; however, to realize this improved accuracy, + * corrections for the essentially unpredictable free-core-nutation + * (fcn) must also be included. + * + * 4) the present routine provides classical nutation. the + * mhb_2000_short algorithm, from which it is adapted, deals also + * with (i) the offsets between the gcrs and mean poles and (ii) the + * adjustments in longitude and obliquity due to the changed + * precession rates. these additional functions, namely frame bias + * and precession adjustments, are supported by the sofa routines + * iau_bi00 and iau_pr00. + * + * 6) the mhb_2000_short algorithm also provides "total" nutations, + * comprising the arithmetic sum of the frame bias, precession + * adjustments, and nutation (luni-solar + planetary). these total + * nutations can be used in combination with an existing IAU 1976 + * precession implementation, such as iau_pmat76, to deliver gcrs-to- + * true predictions of mas accuracy at current epochs. however, for + * symmetry with the iau_nut00a routine (q.v. for the reasons), the + * sofa routines do not generate the "total nutations" directly. + * should they be required, they could of course easily be generated + * by calling iau_bi00, iau_pr00 and the present routine and adding + * the results. + * + * 7) the IAU 2000b model includes "planetary bias" terms that are fixed + * in size but compensate for long-period nutations. the amplitudes + * quoted in mccarthy & luzum (2003), namely dpsi = -1.5835 mas and + * depsilon = +1.6339 mas, are optimized for the "total nutations" + * method described in note 6. the luzum (2001) values used in this + * sofa implementation, namely -0.135 mas and +0.388 mas, are + * optimized for the "rigorous" method, where frame bias, precession + * and nutation are applied separately and in that order. during the + * interval 1995-2050, the sofa implementation delivers a maximum + * error of 1.001 mas (not including fcn). + * + * References from original Fortran subroutines: + * + * Hilton, J. et al., 2006, Celest.Mech.Dyn.Astron. 94, 351 + * + * Lieske, J.H., Lederle, T., Fricke, W., Morando, B., "Expressions + * for the precession quantities based upon the IAU 1976 system of + * astronomical constants", Astron.Astrophys. 58, 1-2, 1-16. (1977) + * + * Luzum, B., private communication, 2001 (Fortran code + * mhb_2000_short) + * + * McCarthy, D.D. & Luzum, B.J., "An abridged model of the + * precession-nutation of the celestial pole", Cel.Mech.Dyn.Astron. + * 85, 37-49 (2003) + * + * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M., + * Francou, G., Laskar, J., Astron.Astrophys. 282, 663-683 (1994) + * + */ + +{ + double as2r = 0.000004848136811095359935899141; /* arcseconds to radians */ + + double dmas2r = as2r / 1000.0; /* milliarcseconds to radians */ + + double as2pi = 1296000.0; /* arc seconds in a full circle */ + + double d2pi = 6.283185307179586476925287; /* 2pi */ + + double u2r = as2r / 10000000.0; /* units of 0.1 microarcsecond to radians */ + + double dj0 = 2451545.0; /* reference epoch (j2000), jd */ + + double djc = 36525.0; /* Days per julian century */ + + /* Miscellaneous */ + double t, el, elp, f, d, om, arg, dp, de, sarg, carg; + double dpsils, depsls, dpsipl, depspl; + int i, j; + + int nls = NLS; /* number of terms in the luni-solar nutation model */ + + /* Fixed offset in lieu of planetary terms (radians) */ + double dpplan = - 0.135 * dmas2r; + double deplan = + 0.388 * dmas2r; + +/* Tables of argument and term coefficients */ + + /* Coefficients for fundamental arguments */ + /* Luni-solar argument multipliers: */ + /* l l' f d om */ +static int nals[5*NLS]= + {0, 0, 0, 0, 1, + 0, 0, 2, -2, 2, + 0, 0, 2, 0, 2, + 0, 0, 0, 0, 2, + 0, 1, 0, 0, 0, + 0, 1, 2, -2, 2, + 1, 0, 0, 0, 0, + 0, 0, 2, 0, 1, + 1, 0, 2, 0, 2, + 0, -1, 2, -2, 2, + 0, 0, 2, -2, 1, + -1, 0, 2, 0, 2, + -1, 0, 0, 2, 0, + 1, 0, 0, 0, 1, + -1, 0, 0, 0, 1, + -1, 0, 2, 2, 2, + 1, 0, 2, 0, 1, + -2, 0, 2, 0, 1, + 0, 0, 0, 2, 0, + 0, 0, 2, 2, 2, + 0, -2, 2, -2, 2, + -2, 0, 0, 2, 0, + 2, 0, 2, 0, 2, + 1, 0, 2, -2, 2, + -1, 0, 2, 0, 1, + 2, 0, 0, 0, 0, + 0, 0, 2, 0, 0, + 0, 1, 0, 0, 1, + -1, 0, 0, 2, 1, + 0, 2, 2, -2, 2, + 0, 0, -2, 2, 0, + 1, 0, 0, -2, 1, + 0, -1, 0, 0, 1, + -1, 0, 2, 2, 1, + 0, 2, 0, 0, 0, + 1, 0, 2, 2, 2, + -2, 0, 2, 0, 0, + 0, 1, 2, 0, 2, + 0, 0, 2, 2, 1, + 0, -1, 2, 0, 2, + 0, 0, 0, 2, 1, + 1, 0, 2, -2, 1, + 2, 0, 2, -2, 2, + -2, 0, 0, 2, 1, + 2, 0, 2, 0, 1, + 0, -1, 2, -2, 1, + 0, 0, 0, -2, 1, + -1, -1, 0, 2, 0, + 2, 0, 0, -2, 1, + 1, 0, 0, 2, 0, + 0, 1, 2, -2, 1, + 1, -1, 0, 0, 0, + -2, 0, 2, 0, 2, + 3, 0, 2, 0, 2, + 0, -1, 0, 2, 0, + 1, -1, 2, 0, 2, + 0, 0, 0, 1, 0, + -1, -1, 2, 2, 2, + -1, 0, 2, 0, 0, + 0, -1, 2, 2, 2, + -2, 0, 0, 0, 1, + 1, 1, 2, 0, 2, + 2, 0, 0, 0, 1, + -1, 1, 0, 1, 0, + 1, 1, 0, 0, 0, + 1, 0, 2, 0, 0, + -1, 0, 2, -2, 1, + 1, 0, 0, 0, 2, + -1, 0, 0, 1, 0, + 0, 0, 2, 1, 2, + -1, 0, 2, 4, 2, + -1, 1, 0, 1, 1, + 0, -2, 2, -2, 1, + 1, 0, 2, 2, 1, + -2, 0, 2, 2, 2, + -1, 0, 0, 0, 2, + 1, 1, 2, -2, 2}; + + /* Luni-solar nutation coefficients, in 1e-7 arcsec */ + /* longitude (sin, t*sin, cos), obliquity (cos, t*cos, sin) */ +static double cls[6*NLS]= + {-172064161.0, -174666.0, 33386.0, 92052331.0, 9086.0, 15377.0, + -13170906.0, -1675.0, -13696.0, 5730336.0, -3015.0, -4587.0, + -2276413.0, -234.0, 2796.0, 978459.0, -485.0, 1374.0, + 2074554.0, 207.0, -698.0, -897492.0, 470.0, -291.0, + 1475877.0, -3633.0, 11817.0, 73871.0, -184.0, -1924.0, + -516821.0, 1226.0, -524.0, 224386.0, -677.0, -174.0, + 711159.0, 73.0, -872.0, -6750.0, 0.0, 358.0, + -387298.0, -367.0, 380.0, 200728.0, 18.0, 318.0, + -301461.0, -36.0, 816.0, 129025.0, -63.0, 367.0, + 215829.0, -494.0, 111.0, -95929.0, 299.0, 132.0, + 128227.0, 137.0, 181.0, -68982.0, -9.0, 39.0, + 123457.0, 11.0, 19.0, -53311.0, 32.0, -4.0, + 156994.0, 10.0, -168.0, -1235.0, 0.0, 82.0, + 63110.0, 63.0, 27.0, -33228.0, 0.0, -9.0, + -57976.0, -63.0, -189.0, 31429.0, 0.0, -75.0, + -59641.0, -11.0, 149.0, 25543.0, -11.0, 66.0, + -51613.0, -42.0, 129.0, 26366.0, 0.0, 78.0, + 45893.0, 50.0, 31.0, -24236.0, -10.0, 20.0, + 63384.0, 11.0, -150.0, -1220.0, 0.0, 29.0, + -38571.0, -1.0, 158.0, 16452.0, -11.0, 68.0, + 32481.0, 0.0, 0.0, -13870.0, 0.0, 0.0, + -47722.0, 0.0, -18.0, 477.0, 0.0, -25.0, + -31046.0, -1.0, 131.0, 13238.0, -11.0, 59.0, + 28593.0, 0.0, -1.0, -12338.0, 10.0, -3.0, + 20441.0, 21.0, 10.0, -10758.0, 0.0, -3.0, + 29243.0, 0.0, -74.0, -609.0, 0.0, 13.0, + 25887.0, 0.0, -66.0, -550.0, 0.0, 11.0, + -14053.0, -25.0, 79.0, 8551.0, -2.0, -45.0, + 15164.0, 10.0, 11.0, -8001.0, 0.0, -1.0, + -15794.0, 72.0, -16.0, 6850.0, -42.0, -5.0, + 21783.0, 0.0, 13.0, -167.0, 0.0, 13.0, + -12873.0, -10.0, -37.0, 6953.0, 0.0, -14.0, + -12654.0, 11.0, 63.0, 6415.0, 0.0, 26.0, + -10204.0, 0.0, 25.0, 5222.0, 0.0, 15.0, + 16707.0, -85.0, -10.0, 168.0, -1.0, 10.0, + -7691.0, 0.0, 44.0, 3268.0, 0.0, 19.0, + -11024.0, 0.0, -14.0, 104.0, 0.0, 2.0, + 7566.0, -21.0, -11.0, -3250.0, 0.0, -5.0, + -6637.0, -11.0, 25.0, 3353.0, 0.0, 14.0, + -7141.0, 21.0, 8.0, 3070.0, 0.0, 4.0, + -6302.0, -11.0, 2.0, 3272.0, 0.0, 4.0, + 5800.0, 10.0, 2.0, -3045.0, 0.0, -1.0, + 6443.0, 0.0, -7.0, -2768.0, 0.0, -4.0, + -5774.0, -11.0, -15.0, 3041.0, 0.0, -5.0, + -5350.0, 0.0, 21.0, 2695.0, 0.0, 12.0, + -4752.0, -11.0, -3.0, 2719.0, 0.0, -3.0, + -4940.0, -11.0, -21.0, 2720.0, 0.0, -9.0, + 7350.0, 0.0, -8.0, -51.0, 0.0, 4.0, + 4065.0, 0.0, 6.0, -2206.0, 0.0, 1.0, + 6579.0, 0.0, -24.0, -199.0, 0.0, 2.0, + 3579.0, 0.0, 5.0, -1900.0, 0.0, 1.0, + 4725.0, 0.0, -6.0, -41.0, 0.0, 3.0, + -3075.0, 0.0, -2.0, 1313.0, 0.0, -1.0, + -2904.0, 0.0, 15.0, 1233.0, 0.0, 7.0, + 4348.0, 0.0, -10.0, -81.0, 0.0, 2.0, + -2878.0, 0.0, 8.0, 1232.0, 0.0, 4.0, + -4230.0, 0.0, 5.0, -20.0, 0.0, -2.0, + -2819.0, 0.0, 7.0, 1207.0, 0.0, 3.0, + -4056.0, 0.0, 5.0, 40.0, 0.0, -2.0, + -2647.0, 0.0, 11.0, 1129.0, 0.0, 5.0, + -2294.0, 0.0, -10.0, 1266.0, 0.0, -4.0, + 2481.0, 0.0, -7.0, -1062.0, 0.0, -3.0, + 2179.0, 0.0, -2.0, -1129.0, 0.0, -2.0, + 3276.0, 0.0, 1.0, -9.0, 0.0, 0.0, + -3389.0, 0.0, 5.0, 35.0, 0.0, -2.0, + 3339.0, 0.0, -13.0, -107.0, 0.0, 1.0, + -1987.0, 0.0, -6.0, 1073.0, 0.0, -2.0, + -1981.0, 0.0, 0.0, 854.0, 0.0, 0.0, + 4026.0, 0.0, -353.0, -553.0, 0.0, -139.0, + 1660.0, 0.0, -5.0, -710.0, 0.0, -2.0, + -1521.0, 0.0, 9.0, 647.0, 0.0, 4.0, + 1314.0, 0.0, 0.0, -700.0, 0.0, 0.0, + -1283.0, 0.0, 0.0, 672.0, 0.0, 0.0, + -1331.0, 0.0, 8.0, 663.0, 0.0, 4.0, + 1383.0, 0.0, -2.0, -594.0, 0.0, -2.0, + 1405.0, 0.0, 4.0, -610.0, 0.0, 2.0, + 1290.0, 0.0, 0.0, -556.0, 0.0, 0.0}; + + /* Interval between fundamental epoch J2000.0 and given date (JC) */ + t = (dj - dj0) / djc; + +/* Luni-solar nutation */ + +/* Fundamental (delaunay) arguments from Simon et al. (1994) */ + + /* Mean anomaly of the moon */ + el = fmod (485868.249036 + (1717915923.2178 * t), as2pi) * as2r; + + /* Mean anomaly of the sun */ + elp = fmod (1287104.79305 + (129596581.0481 * t), as2pi) * as2r; + + /* Mean argument of the latitude of the moon */ + f = fmod (335779.526232 + (1739527262.8478 * t), as2pi) * as2r; + + /* Mean elongation of the moon from the sun */ + d = fmod (1072260.70369 + (1602961601.2090 * t), as2pi ) * as2r; + + /* Mean longitude of the ascending node of the moon */ + om = fmod (450160.398036 - (6962890.5431 * t), as2pi ) * as2r; + + /* Initialize the nutation values */ + dp = 0.0; + de = 0.0; + + /* Summation of luni-solar nutation series (in reverse order) */ + for (i = nls; i > 0; i=i-1) { + j = i - 1; + + /* Argument and functions */ + arg = fmod ( (double) (nals[5*j]) * el + + (double) (nals[1+5*j]) * elp + + (double) (nals[2+5*j]) * f + + (double) (nals[3+5*j]) * d + + (double) (nals[4+5*j]) * om, d2pi); + sarg = sin (arg); + carg = cos (arg); + + /* Terms */ + dp = dp + (cls[6*j] + cls[1+6*j] * t) * sarg + cls[2+6*j] * carg; + de = de + (cls[3+6*j] + cls[4+6*j] * t) * carg + cls[5+6*j] * sarg; + } + + /* Convert from 0.1 microarcsec units to radians */ + dpsils = dp * u2r; + depsls = de * u2r; + +/* In lieu of planetary nutation */ + + /* Fixed offset to correct for missing terms in truncated series */ + dpsipl = dpplan; + depspl = deplan; + +/* Results */ + + /* Add luni-solar and planetary components */ + *dpsi = dpsils + dpsipl; + *deps = depsls + depspl; + + /* Mean Obliquity in radians (IAU 2006, Hilton, et al.) */ + *eps0 = ( 84381.406 + + ( -46.836769 + + ( -0.0001831 + + ( 0.00200340 + + ( -0.000000576 + + ( -0.0000000434 ) * t ) * t ) * t ) * t ) * t ) * as2r; +} + + +/* ISDATE - Return 1 if string is an old or ISO FITS standard date */ + +int +isdate (string) + +char *string; /* Possible FITS date string, which may be: + dd/mm/yy (FITS standard before 2000) + dd-mm-yy (nonstandard FITS use before 2000) + yyyy-mm-dd (FITS standard after 1999) + yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + +{ + int iyr = 0; /* year (returned) */ + int imon = 0; /* month (returned) */ + int iday = 0; /* day (returned) */ + int i; + char *sstr, *dstr, *tstr, *nval; + + /* Translate string from ASCII to binary */ + if (string == NULL) + return (0); + + sstr = strchr (string,'/'); + dstr = strchr (string,'-'); + if (dstr == string) + dstr = strchr (string+1,'-'); + tstr = strchr (string,'T'); + + /* Original FITS date format: dd/mm/yy */ + if (sstr > string) { + *sstr = '\0'; + iday = (int) atof (string); + *sstr = '/'; + nval = sstr + 1; + sstr = strchr (nval,'/'); + if (sstr == NULL) + sstr = strchr (nval,'-'); + if (sstr > string) { + *sstr = '\0'; + imon = (int) atof (nval); + *sstr = '/'; + nval = sstr + 1; + iyr = (int) atof (nval); + if (iyr < 1000) + iyr = iyr + 1900; + } + if (imon > 0 && iday > 0) + return (1); + else + return (0); + } + + /* New FITS date format: yyyy-mm-ddThh:mm:ss[.sss] */ + else if (dstr > string) { + *dstr = '\0'; + iyr = (int) atof (string); + nval = dstr + 1; + *dstr = '-'; + dstr = strchr (nval,'-'); + imon = 0; + iday = 0; + + /* Decode year, month, and day */ + if (dstr > string) { + *dstr = '\0'; + imon = (int) atof (nval); + *dstr = '-'; + nval = dstr + 1; + if (tstr > string) + *tstr = '\0'; + iday = (int) atof (nval); + if (tstr > string) + *tstr = 'T'; + } + + /* If day is > 31, it is really year in old format */ + if (iday > 31) { + i = iyr; + if (iday < 100) + iyr = iday + 1900; + else + iyr = iday; + iday = i; + } + if (imon > 0 && iday > 0) + return (1); + else + return (0); + } + + /* If FITS date is entered as an epoch, return 0 anyway */ + else + return (0); +} + + +/* Round seconds and make sure date and time numbers are within limits */ + +static void +fixdate (iyr, imon, iday, ihr, imn, sec, ndsec) + +int *iyr; /* year (returned) */ +int *imon; /* month (returned) */ +int *iday; /* day (returned) */ +int *ihr; /* hours (returned) */ +int *imn; /* minutes (returned) */ +double *sec; /* seconds (returned) */ +int ndsec; /* Number of decimal places in seconds (0=int) */ +{ + double days; + + /* Round seconds to 0 - 4 decimal places (no rounding if <0, >4) */ + if (ndsec == 0) + *sec = dint (*sec + 0.5); + else if (ndsec < 2) + *sec = dint (*sec * 10.0 + 0.5) / 10.0; + else if (ndsec < 3) + *sec = dint (*sec * 100.0 + 0.5) / 100.0; + else if (ndsec < 4) + *sec = dint (*sec * 1000.0 + 0.5) / 1000.0; + else if (ndsec < 5) + *sec = dint (*sec * 10000.0 + 0.5) / 10000.0; + + /* Adjust minutes and hours */ + if (*sec > 60.0) { + *sec = *sec - 60.0; + *imn = *imn + 1; + } + if (*imn > 60) { + *imn = *imn - 60; + *ihr = *ihr + 1; + } + + /* Return if no date */ + if (*iyr == 0 && *imon == 0 && *iday == 0) + return; + + /* Adjust date */ + if (*ihr > 23) { + *ihr = *ihr - 24; + *iday = *iday + 1; + } + days = caldays (*iyr, *imon); + if (*iday > days) { + *iday = *iday - days; + *imon = *imon + 1; + } + if (*iday < 1) { + *imon = *imon - 1; + if (*imon < 1) { + *imon = *imon + 12; + *iyr = *iyr - 1; + } + days = caldays (*iyr, *imon); + *iday = *iday + days; + } + if (*imon < 1) { + *imon = *imon + 12; + *iyr = *iyr - 1; + days = caldays (*iyr, *imon); + if (*iday > days) { + *iday = *iday - days; + *imon = *imon + 1; + } + } + if (*imon > 12) { + *imon = *imon - 12; + *iyr = *iyr + 1; + } + return; +} + + +/* Calculate days in month 1-12 given year (Gregorian calendar only) */ + +static int +caldays (year, month) + +int year; /* 4-digit year */ +int month; /* Month (1=January, 2=February, etc.) */ +{ + if (month < 1) { + month = month + 12; + year = year + 1; + } + if (month > 12) { + month = month - 12; + year = year + 1; + } + switch (month) { + case 1: + return (31); + case 2: + if (year%400 == 0) + return (29); + else if (year%100 == 0) + return (28); + else if (year%4 == 0) + return (29); + else + return (28); + case 3: + return (31); + case 4: + return (30); + case 5: + return (31); + case 6: + return (30); + case 7: + return (31); + case 8: + return (31); + case 9: + return (30); + case 10: + return (31); + case 11: + return (30); + case 12: + return (31); + default: + return (0); + } +} + + +static double +dint (dnum) + +double dnum; +{ + double dn; + + if (dnum < 0.0) + dn = -floor (-dnum); + else + dn = floor (dnum); + return (dn); +} + + +static double +dmod (dnum, dm) + +double dnum, dm; +{ + double dnumx, dnumi, dnumf; + if (dnum < 0.0) + dnumx = -dnum; + else + dnumx = dnum; + dnumi = dint (dnumx / dm); + if (dnum < 0.0) + dnumf = dnum + (dnumi * dm); + else if (dnum > 0.0) + dnumf = dnum - (dnumi * dm); + else + dnumf = 0.0; + return (dnumf); +} + +/* Jul 1 1999 New file, based on iolib/jcon.f and iolib/vcon.f and hgetdate() + * Oct 21 1999 Fix declarations after lint + * Oct 27 1999 Fix bug to return epoch if fractional year input + * Dec 9 1999 Fix bug in ts2jd() found by Pete Ratzlaff (SAO) + * Dec 17 1999 Add all unimplemented conversions + * Dec 20 1999 Add isdate(); leave date, time strings unchanged in fd2i() + * Dec 20 1999 Make all fd2*() subroutines deal with time alone + * + * Jan 3 2000 In old FITS format, year 100 is assumed to be 2000 + * Jan 11 2000 Fix epoch to date conversion so .0 is 0:00, not 12:00 + * Jan 21 2000 Add separate Besselian and Julian epoch computations + * Jan 28 2000 Add Modified Julian Date conversions + * Mar 2 2000 Implement decimal places for FITS date string + * Mar 14 2000 Fix bug in dealing with 2000-02-29 in ts2i() + * Mar 22 2000 Add lt2* and ut2* to get current time as local and UT + * Mar 24 2000 Fix calloc() calls + * Mar 24 2000 Add tsi2* and tsu2* to convert IRAF and Unix seconds + * May 1 2000 In old FITS format, all years < 1000 get 1900 added to them + * Aug 1 2000 Make ep2jd and jd2ep consistently starting at 1/1 0:00 + * + * Jan 11 2001 Print all messages to stderr + * May 21 2001 Add day of year conversions + * May 25 2001 Allow fraction of day in FITS date instead of time + * + * Apr 8 2002 Change all long declaration to time_t + * May 13 2002 Fix bugs found by lint + * Jul 5 2002 Fix bug in fixdate() so fractional seconds come out + * Jul 8 2002 Fix rounding bug in t2i() + * Jul 8 2002 Try Fliegel and Van Flandern's algorithm for JD to UT date + * Jul 8 2002 If first character of string is -, check for other -'s in isdate + * Sep 10 2002 Add ET/TDT/TT conversion from UT subroutines + * Sep 10 2002 Add sidereal time conversions + * + * Jan 30 2003 Fix typo in ts2gst() + * Mar 7 2003 Add conversions for heliocentric julian dates + * May 20 2003 Declare nd in setdatedec() + * Jul 18 2003 Add code to parse Las Campanas dates + * + * Mar 24 2004 If ndec > 0, add UT to FITS date even if it is 0:00:00 + * + * Oct 14 2005 Add tsd2fd() and tsd2dt() + * + * May 3 2006 Drop declaration of unused variables + * Jun 20 2006 Initialized uninitialized variables + * Aug 2 2006 Add local sidereal time + * Sep 13 2006 Add more local sidereal time subroutines + * Oct 2 2006 Add UT to old FITS date conversions + * Oct 6 2006 Add eqeqnx() to compute equation of the equinoxes + * + * Jan 8 2007 Remove unused variables + * + * Sep 5 2008 Replace nutation with IAU 2006 model translated from SOFA + * Sep 9 2008 Add ang2hr(), ang2deg(), hr2ang(), deg2ang() + * Sep 10 2008 Add longitude to mean standard time (default = Greenwich) + * Oct 8 2008 Clean up sidereal time computations + * + * Sep 24 2009 Add end to comment "Coefficients for fundamental arguments" + * + * Jan 11 2012 Add TAI, TT, GPS time + * Oct 19 2012 Unused l0 dropped from jd2lst(); ts2ss from jd2mst() + */ diff --git a/tksao/wcssubs/distort.c b/tksao/wcssubs/distort.c new file mode 100644 index 0000000..d903dfe --- /dev/null +++ b/tksao/wcssubs/distort.c @@ -0,0 +1,407 @@ +/*** File libwcs/distort.c + *** January 4, 2007 + *** By Jessica Mink, jmink@cfa.harvard.edu, + *** Based on code written by Jing Li, IPAC + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 2004-2007 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: distort.c (World Coordinate Systems) + * Purpose: Convert focal plane coordinates to pixels and vice versa: + * Subroutine: distortinit (wcs, hstring) set distortion coefficients from FITS header + * Subroutine: DelDistort (header, verbose) delete distortion coefficients in FITS header + * Subroutine: pix2foc (wcs, x, y, u, v) pixel coordinates -> focal plane coordinates + * Subroutine: foc2pix (wcs, u, v, x, y) focal plane coordinates -> pixel coordinates + * Subroutine: setdistcode (wcs,ctype) sets distortion code from CTYPEi + * Subroutine: getdistcode (wcs) returns distortion code string for CTYPEi + */ + +#include <unistd.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "wcs.h" + +void +distortinit (wcs, hstring) +struct WorldCoor *wcs; /* World coordinate system structure */ +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +{ + int i, j, m; + char keyword[12]; + + /* Read distortion coefficients, if present */ + if (wcs->distcode == DISTORT_SIRTF) { + if (wcs->wcsproj == WCS_OLD) { + wcs->wcsproj = WCS_NEW; + wcs->distort.a_order = 0; + wcs->distort.b_order = 0; + wcs->distort.ap_order = 0; + wcs->distort.bp_order = 0; + } + else { + if (!hgeti4 (hstring, "A_ORDER", &wcs->distort.a_order)) { + setwcserr ("DISTINIT: Missing A_ORDER keyword for Spitzer distortion"); + } + else { + m = wcs->distort.a_order; + for (i = 0; i <= m; i++) { + for (j = 0; j <= m; j++) { + wcs->distort.a[i][j] = 0.0; + } + } + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "A_%d_%d", i, j); + hgetr8 (hstring, keyword, &wcs->distort.a[i][j]); + } + } + } + if (!hgeti4 (hstring, "B_ORDER", &wcs->distort.b_order)) { + setwcserr ("DISTINIT: Missing B_ORDER keyword for Spitzer distortion"); + } + else { + m = wcs->distort.b_order; + for (i = 0; i <= m; i++) { + for (j = 0; j <= m; j++) { + wcs->distort.b[i][j] = 0.0; + } + } + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "B_%d_%d", i, j); + hgetr8 (hstring, keyword, &wcs->distort.b[i][j]); + } + } + } + if (!hgeti4 (hstring, "AP_ORDER", &wcs->distort.ap_order)) { + setwcserr ("DISTINIT: Missing AP_ORDER keyword for Spitzer distortion"); + } + else { + m = wcs->distort.ap_order; + for (i = 0; i <= m; i++) { + for (j = 0; j <= m; j++) { + wcs->distort.ap[i][j] = 0.0; + } + } + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "AP_%d_%d", i, j); + hgetr8 (hstring, keyword, &wcs->distort.ap[i][j]); + } + } + } + if (!hgeti4 (hstring, "BP_ORDER", &wcs->distort.bp_order)) { + setwcserr ("DISTINIT: Missing BP_ORDER keyword for Spitzer distortion"); + } + else { + m = wcs->distort.bp_order; + for (i = 0; i <= m; i++) { + for (j = 0; j <= m; j++) { + wcs->distort.bp[i][j] = 0.0; + } + } + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "BP_%d_%d", i, j); + hgetr8 (hstring, keyword, &wcs->distort.bp[i][j]); + } + } + } + } + } + return; +} + + +/* Delete all distortion-related fields. + * return 0 if at least one such field is found, else -1. */ + +int +DelDistort (header, verbose) + +char *header; +int verbose; + +{ + char keyword[16]; + char str[32]; + int i, j, m; + int lctype; + int n; + + n = 0; + + if (hgeti4 (header, "A_ORDER", &m)) { + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "A_%d_%d", i, j); + hdel (header, keyword); + n++; + } + } + hdel (header, "A_ORDER"); + n++; + } + + if (hgeti4 (header, "AP_ORDER", &m)) { + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "AP_%d_%d", i, j); + hdel (header, keyword); + n++; + } + } + hdel (header, "AP_ORDER"); + n++; + } + + if (hgeti4 (header, "B_ORDER", &m)) { + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "B_%d_%d", i, j); + hdel (header, keyword); + n++; + } + } + hdel (header, "B_ORDER"); + n++; + } + + if (hgeti4 (header, "BP_ORDER", &m)) { + for (i = 0; i <= m; i++) { + for (j = 0; j <= m-i; j++) { + sprintf (keyword, "BP_%d_%d", i, j); + hdel (header, keyword); + n++; + } + } + hdel (header, "BP_ORDER"); + n++; + } + + if (n > 0 && verbose) + fprintf (stderr,"%d keywords deleted\n", n); + + /* Remove WCS distortion code from CTYPEi in FITS header */ + if (hgets (header, "CTYPE1", 31, str)) { + lctype = strlen (str); + if (lctype > 8) { + str[8] = (char) 0; + hputs (header, "CTYPE1", str); + } + } + if (hgets (header, "CTYPE2", 31, str)) { + lctype = strlen (str); + if (lctype > 8) { + str[8] = (char) 0; + hputs (header, "CTYPE2", str); + } + } + + return (n); +} + +void +foc2pix (wcs, x, y, u, v) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double x, y; /* Focal plane coordinates */ +double *u, *v; /* Image pixel coordinates (returned) */ +{ + int m, n, i, j, k; + double s[DISTMAX], sum; + double temp_x, temp_y; + + /* Spitzer distortion */ + if (wcs->distcode == DISTORT_SIRTF) { + m = wcs->distort.ap_order; + n = wcs->distort.bp_order; + + temp_x = x - wcs->xrefpix; + temp_y = y - wcs->yrefpix; + + /* compute u */ + for (j = 0; j <= m; j++) { + s[j] = wcs->distort.ap[m-j][j]; + for (k = j-1; k >= 0; k--) { + s[j] = (temp_y * s[j]) + wcs->distort.ap[m-j][k]; + } + } + + sum = s[0]; + for (i=m; i>=1; i--){ + sum = (temp_x * sum) + s[m-i+1]; + } + *u = sum; + + /* compute v*/ + for (j = 0; j <= n; j++) { + s[j] = wcs->distort.bp[n-j][j]; + for (k = j-1; k >= 0; k--) { + s[j] = temp_y*s[j] + wcs->distort.bp[n-j][k]; + } + } + + sum = s[0]; + for (i = n; i >= 1; i--) + sum = temp_x * sum + s[n-i+1]; + + *v = sum; + + *u = x + *u; + *v = y + *v; + } + + /* If no distortion, return pixel positions unchanged */ + else { + *u = x; + *v = y; + } + + return; +} + + +void +pix2foc (wcs, u, v, x, y) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double u, v; /* Image pixel coordinates */ +double *x, *y; /* Focal plane coordinates (returned) */ +{ + int m, n, i, j, k; + double s[DISTMAX], sum; + double temp_u, temp_v; + + /* Spitzer distortion */ + if (wcs->distcode == DISTORT_SIRTF) { + m = wcs->distort.a_order; + n = wcs->distort.b_order; + + temp_u = u - wcs->xrefpix; + temp_v = v - wcs->yrefpix; + + /* compute u */ + for (j = 0; j <= m; j++) { + s[j] = wcs->distort.a[m-j][j]; + for (k = j-1; k >= 0; k--) { + s[j] = (temp_v * s[j]) + wcs->distort.a[m-j][k]; + } + } + + sum = s[0]; + for (i=m; i>=1; i--){ + sum = temp_u*sum + s[m-i+1]; + } + *x = sum; + + /* compute v*/ + for (j=0; j<=n; j++) { + s[j] = wcs->distort.b[n-j][j]; + for (k=j-1; k>=0; k--) { + s[j] =temp_v*s[j] + wcs->distort.b[n-j][k]; + } + } + + sum = s[0]; + for (i=n; i>=1; i--) + sum = temp_u*sum + s[n-i+1]; + + *y = sum; + + *x = u + *x; + *y = v + *y; + +/* *x = u + *x + coeff.crpix1; */ +/* *y = v + *y + coeff.crpix2; */ + } + + /* If no distortion, return pixel positions unchanged */ + else { + *x = u; + *y = v; + } + + return; +} + + +/* SETDISTCODE -- Set WCS distortion code from CTYPEi in FITS header */ + +void +setdistcode (wcs, ctype) + +struct WorldCoor *wcs; /* World coordinate system structure */ +char *ctype; /* Value of CTYPEi from FITS header */ + +{ + char *extension; + int lctype; + + lctype = strlen (ctype); + if (lctype < 9) + wcs->distcode = DISTORT_NONE; + else { + extension = ctype + 8; + if (!strncmp (extension, "-SIP", 4)) + wcs->distcode = DISTORT_SIRTF; + else + wcs->distcode = DISTORT_NONE; + } + return; +} + + +/* GETDISTCODE -- Return NULL if no distortion or code from wcs.h */ + +char * +getdistcode (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ + +{ + char *dcode; /* Distortion string for CTYPEi */ + + if (wcs->distcode == DISTORT_SIRTF) { + dcode = (char *) calloc (8, sizeof (char)); + strcpy (dcode, "-SIP"); + } + else + dcode = NULL; + return (dcode); +} + +/* Apr 2 2003 New subroutines + * Nov 3 2003 Add getdistcode to return distortion code string + * Nov 10 2003 Include unistd.h to get definition of NULL + * Nov 18 2003 Include string.h to get strlen() + * + * Jan 9 2004 Add DelDistort() to delete distortion keywords + * + * Jan 4 2007 Declare header const char* + * + * Feb 25 2011 Change SIRTF to Spitzer (long overdue!) + */ diff --git a/tksao/wcssubs/dsspos.c b/tksao/wcssubs/dsspos.c new file mode 100644 index 0000000..3bbd5a0 --- /dev/null +++ b/tksao/wcssubs/dsspos.c @@ -0,0 +1,318 @@ +/*** File saoimage/wcslib/dsspos.c + *** October 21, 1999 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1995-2002 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: dsspos.c (Plate solution WCS conversion) + * Purpose: Compute WCS from Digital Sky Survey plate fit + * Subroutine: dsspos() converts from pixel location to RA,Dec + * Subroutine: dsspix() converts from RA,Dec to pixel location + + These functions are based on the astrmcal.c portion of GETIMAGE by + J. Doggett and the documentation distributed with the Digital Sky Survey. + +*/ + +#include <math.h> +#include <string.h> +#include <stdio.h> +#include "wcs.h" + +int +dsspos (xpix, ypix, wcs, xpos, ypos) + +/* Routine to determine accurate position for pixel coordinates */ +/* returns 0 if successful otherwise 1 = angle too large for projection; */ +/* based on amdpos() from getimage */ + +/* Input: */ +double xpix; /* x pixel number (RA or long without rotation) */ +double ypix; /* y pixel number (dec or lat without rotation) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpos; /* Right ascension or longitude in degrees */ +double *ypos; /* Declination or latitude in degrees */ + +{ + double x, y, xmm, ymm, xmm2, ymm2, xmm3, ymm3, x2y2; + double xi, xir, eta, etar, raoff, ra, dec; + double cond2r = 1.745329252e-2; + double cons2r = 206264.8062470964; + double twopi = 6.28318530717959; + double ctan, ccos; + +/* Ignore magnitude and color terms + double mag = 0.0; + double color = 0.0; */ + +/* Convert from image pixels to plate pixels */ + x = xpix + wcs->x_pixel_offset - 1.0 + 0.5; + y = ypix + wcs->y_pixel_offset - 1.0 + 0.5; + +/* Convert from pixels to millimeters */ + xmm = (wcs->ppo_coeff[2] - x * wcs->x_pixel_size) / 1000.0; + ymm = (y * wcs->y_pixel_size - wcs->ppo_coeff[5]) / 1000.0; + xmm2 = xmm * xmm; + ymm2 = ymm * ymm; + xmm3 = xmm * xmm2; + ymm3 = ymm * ymm2; + x2y2 = xmm2 + ymm2; + +/* Compute coordinates from x,y and plate model */ + + xi = wcs->x_coeff[ 0]*xmm + wcs->x_coeff[ 1]*ymm + + wcs->x_coeff[ 2] + wcs->x_coeff[ 3]*xmm2 + + wcs->x_coeff[ 4]*xmm*ymm + wcs->x_coeff[ 5]*ymm2 + + wcs->x_coeff[ 6]*(x2y2) + wcs->x_coeff[ 7]*xmm3 + + wcs->x_coeff[ 8]*xmm2*ymm + wcs->x_coeff[ 9]*xmm*ymm2 + + wcs->x_coeff[10]*ymm3 + wcs->x_coeff[11]*xmm*(x2y2) + + wcs->x_coeff[12]*xmm*x2y2*x2y2; + +/* Ignore magnitude and color terms + + wcs->x_coeff[13]*mag + wcs->x_coeff[14]*mag*mag + + wcs->x_coeff[15]*mag*mag*mag + wcs->x_coeff[16]*mag*xmm + + wcs->x_coeff[17]*mag*x2y2 + wcs->x_coeff[18]*mag*xmm*x2y2 + + wcs->x_coeff[19]*color; */ + + eta = wcs->y_coeff[ 0]*ymm + wcs->y_coeff[ 1]*xmm + + wcs->y_coeff[ 2] + wcs->y_coeff[ 3]*ymm2 + + wcs->y_coeff[ 4]*xmm*ymm + wcs->y_coeff[ 5]*xmm2 + + wcs->y_coeff[ 6]*(x2y2) + wcs->y_coeff[ 7]*ymm3 + + wcs->y_coeff[ 8]*ymm2*xmm + wcs->y_coeff[ 9]*ymm*xmm2 + + wcs->y_coeff[10]*xmm3 + wcs->y_coeff[11]*ymm*(x2y2) + + wcs->y_coeff[12]*ymm*x2y2*x2y2; + +/* Ignore magnitude and color terms + + wcs->y_coeff[13]*mag + wcs->y_coeff[14]*mag*mag + + wcs->y_coeff[15]*mag*mag*mag + wcs->y_coeff[16]*mag*ymm + + wcs->y_coeff[17]*mag*x2y2) + wcs->y_coeff[18]*mag*ymm*x2y2 + + wcs->y_coeff[19]*color; */ + +/* Convert to radians */ + + xir = xi / cons2r; + etar = eta / cons2r; + +/* Convert to RA and Dec */ + + ctan = tan (wcs->plate_dec); + ccos = cos (wcs->plate_dec); + raoff = atan2 (xir / ccos, 1.0 - etar * ctan); + ra = raoff + wcs->plate_ra; + if (ra < 0.0) ra = ra + twopi; + *xpos = ra / cond2r; + + dec = atan (cos (raoff) * ((etar + ctan) / (1.0 - (etar * ctan)))); + *ypos = dec / cond2r; + return 0; +} + + +int +dsspix (xpos, ypos, wcs, xpix, ypix) + +/* Routine to determine pixel coordinates for sky position */ +/* returns 0 if successful otherwise 1 = angle too large for projection; */ +/* based on amdinv() from getimage */ + +/* Input: */ +double xpos; /* Right ascension or longitude in degrees */ +double ypos; /* Declination or latitude in degrees */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpix; /* x pixel number (RA or long without rotation) */ +double *ypix; /* y pixel number (dec or lat without rotation) */ + +{ + double div,xi,eta,x,y,xy,x2,y2,x2y,y2x,x3,y3,x4,y4,x2y2,cjunk,dx,dy; + double sypos,cypos,syplate,cyplate,sxdiff,cxdiff; + double f,fx,fy,g,gx,gy, xmm, ymm; + double conr2s = 206264.8062470964; + double tolerance = 0.0000005; + int max_iterations = 50; + int i; + double xr, yr; /* position in radians */ + + *xpix = 0.0; + *ypix = 0.0; + +/* Convert RA and Dec in radians to standard coordinates on a plate */ + xr = degrad (xpos); + yr = degrad (ypos); + sypos = sin (yr); + cypos = cos (yr); + if (wcs->plate_dec == 0.0) + wcs->plate_dec = degrad (wcs->yref); + syplate = sin (wcs->plate_dec); + cyplate = cos (wcs->plate_dec); + if (wcs->plate_ra == 0.0) + wcs->plate_ra = degrad (wcs->yref); + sxdiff = sin (xr - wcs->plate_ra); + cxdiff = cos (xr - wcs->plate_ra); + div = (sypos * syplate) + (cypos * cyplate * cxdiff); + if (div == 0.0) + return (1); + xi = cypos * sxdiff * conr2s / div; + eta = ((sypos * cyplate) - (cypos * syplate * cxdiff)) * conr2s / div; + +/* Set initial value for x,y */ + if (wcs->plate_scale == 0.0) + return (1); + xmm = xi / wcs->plate_scale; + ymm = eta / wcs->plate_scale; + +/* Iterate by Newton's method */ + for (i = 0; i < max_iterations; i++) { + + /* X plate model */ + xy = xmm * ymm; + x2 = xmm * xmm; + y2 = ymm * ymm; + x2y = x2 * ymm; + y2x = y2 * xmm; + x2y2 = x2 + y2; + cjunk = x2y2 * x2y2; + x3 = x2 * xmm; + y3 = y2 * ymm; + x4 = x2 * x2; + y4 = y2 * y2; + f = wcs->x_coeff[0]*xmm + wcs->x_coeff[1]*ymm + + wcs->x_coeff[2] + wcs->x_coeff[3]*x2 + + wcs->x_coeff[4]*xy + wcs->x_coeff[5]*y2 + + wcs->x_coeff[6]*x2y2 + wcs->x_coeff[7]*x3 + + wcs->x_coeff[8]*x2y + wcs->x_coeff[9]*y2x + + wcs->x_coeff[10]*y3 + wcs->x_coeff[11]*xmm*x2y2 + + wcs->x_coeff[12]*xmm*cjunk; + /* magnitude and color terms ignored + + wcs->x_coeff[13]*mag + + wcs->x_coeff[14]*mag*mag + wcs->x_coeff[15]*mag*mag*mag + + wcs->x_coeff[16]*mag*xmm + wcs->x_coeff[17]*mag*(x2+y2) + + wcs->x_coeff[18]*mag*xmm*(x2+y2) + wcs->x_coeff[19]*color; + */ + + /* Derivative of X model wrt x */ + fx = wcs->x_coeff[0] + wcs->x_coeff[3]*2.0*xmm + + wcs->x_coeff[4]*ymm + wcs->x_coeff[6]*2.0*xmm + + wcs->x_coeff[7]*3.0*x2 + wcs->x_coeff[8]*2.0*xy + + wcs->x_coeff[9]*y2 + wcs->x_coeff[11]*(3.0*x2+y2) + + wcs->x_coeff[12]*(5.0*x4 +6.0*x2*y2+y4); + /* magnitude and color terms ignored + wcs->x_coeff[16]*mag + wcs->x_coeff[17]*mag*2.0*xmm + + wcs->x_coeff[18]*mag*(3.0*x2+y2); + */ + + /* Derivative of X model wrt y */ + fy = wcs->x_coeff[1] + wcs->x_coeff[4]*xmm + + wcs->x_coeff[5]*2.0*ymm + wcs->x_coeff[6]*2.0*ymm + + wcs->x_coeff[8]*x2 + wcs->x_coeff[9]*2.0*xy + + wcs->x_coeff[10]*3.0*y2 + wcs->x_coeff[11]*2.0*xy + + wcs->x_coeff[12]*4.0*xy*x2y2; + /* magnitude and color terms ignored + wcs->x_coeff[17]*mag*2.0*ymm + + wcs->x_coeff[18]*mag*2.0*xy; + */ + + /* Y plate model */ + g = wcs->y_coeff[0]*ymm + wcs->y_coeff[1]*xmm + + wcs->y_coeff[2] + wcs->y_coeff[3]*y2 + + wcs->y_coeff[4]*xy + wcs->y_coeff[5]*x2 + + wcs->y_coeff[6]*x2y2 + wcs->y_coeff[7]*y3 + + wcs->y_coeff[8]*y2x + wcs->y_coeff[9]*x2y + + wcs->y_coeff[10]*x3 + wcs->y_coeff[11]*ymm*x2y2 + + wcs->y_coeff[12]*ymm*cjunk; + /* magnitude and color terms ignored + wcs->y_coeff[13]*mag + wcs->y_coeff[14]*mag*mag + + wcs->y_coeff[15]*mag*mag*mag + wcs->y_coeff[16]*mag*ymm + + wcs->y_coeff[17]*mag*x2y2 + + wcs->y_coeff[18]*mag*ymm*x2y2 + wcs->y_coeff[19]*color; + */ + + /* Derivative of Y model wrt x */ + gx = wcs->y_coeff[1] + wcs->y_coeff[4]*ymm + + wcs->y_coeff[5]*2.0*xmm + wcs->y_coeff[6]*2.0*xmm + + wcs->y_coeff[8]*y2 + wcs->y_coeff[9]*2.0*xy + + wcs->y_coeff[10]*3.0*x2 + wcs->y_coeff[11]*2.0*xy + + wcs->y_coeff[12]*4.0*xy*x2y2; + /* magnitude and color terms ignored + wcs->y_coeff[17]*mag*2.0*xmm + + wcs->y_coeff[18]*mag*ymm*2.0*xmm; + */ + + /* Derivative of Y model wrt y */ + gy = wcs->y_coeff[0] + wcs->y_coeff[3]*2.0*ymm + + wcs->y_coeff[4]*xmm + wcs->y_coeff[6]*2.0*ymm + + wcs->y_coeff[7]*3.0*y2 + wcs->y_coeff[8]*2.0*xy + + wcs->y_coeff[9]*x2 + wcs->y_coeff[11]*(x2+3.0*y2) + + wcs->y_coeff[12]*(5.0*y4 + 6.0*x2*y2 + x4); + /* magnitude and color terms ignored + wcs->y_coeff[16]*mag + wcs->y_coeff[17]*mag*2.0*ymm + + wcs->y_coeff[18]*mag*(x2+3.0*y2); + */ + + f = f - xi; + g = g - eta; + dx = ((-f * gy) + (g * fy)) / ((fx * gy) - (fy * gx)); + dy = ((-g * fx) + (f * gx)) / ((fx * gy) - (fy * gx)); + xmm = xmm + dx; + ymm = ymm + dy; + if ((fabs(dx) < tolerance) && (fabs(dy) < tolerance)) break; + } + +/* Convert mm from plate center to plate pixels */ + if (wcs->x_pixel_size == 0.0 || wcs->y_pixel_size == 0.0) + return (1); + x = (wcs->ppo_coeff[2] - xmm*1000.0) / wcs->x_pixel_size; + y = (wcs->ppo_coeff[5] + ymm*1000.0) / wcs->y_pixel_size; + +/* Convert from plate pixels to image pixels */ + *xpix = x - wcs->x_pixel_offset + 1.0 - 0.5; + *ypix = y - wcs->y_pixel_offset + 1.0 - 0.5; + +/* If position is off of the image, return offscale code */ + if (*xpix < 0.5 || *xpix > wcs->nxpix+0.5) + return -1; + if (*ypix < 0.5 || *ypix > wcs->nypix+0.5) + return -1; + + return 0; +} +/* Mar 6 1995 Original version of this code + * May 4 1995 Fix eta cross terms which were all in y + * Jun 21 1995 Add inverse routine + * Oct 17 1995 Fix inverse routine (degrees -> radians) + * Nov 7 1995 Add half pixel to image coordinates to get astrometric + * plate coordinates + * Feb 26 1996 Fix plate to image pixel conversion error + * + * Mar 23 1998 Change names from plate*() to dss*() + * Apr 7 1998 Change amd_i_coeff to i_coeff + * Sep 4 1998 Fix possible divide by zero in dsspos() from Allen Harris, SAO + * Sep 10 1998 Fix possible divide by zero in dsspix() from Allen Harris, SAO + * + * Oct 21 1999 Drop declaration of cond2r in dsspix() + */ diff --git a/tksao/wcssubs/fileutil.c b/tksao/wcssubs/fileutil.c new file mode 100644 index 0000000..cf52903 --- /dev/null +++ b/tksao/wcssubs/fileutil.c @@ -0,0 +1,867 @@ +/*** File libwcs/fileutil.c + *** August 28, 2014 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1999-2014 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: fileutil.c (ASCII file utilities) + * Purpose: Find out things about ASCII files + * Subroutine: getfilelines (filename) + * Return number of lines in an ASCII file + * Subroutine: getfilebuff (filename) + * Return entire file contents in a character string + * Subroutine: getfilesize (filename) + * Return size of a binary or ASCII file + * Subroutine: isimlist (filename) + * Return 1 if file is list of FITS or IRAF image files, else 0 + * Subroutine: isimlistd (filename, rootdir) + * Return 1 if file is list of FITS or IRAF image files, else 0 + * Subroutine: isfilelist (filename, rootdir) + * Return 1 if file is list of readable files, else 0 + * Subroutine: isfile (filename) + * Return 1 if file is a readable file, else 0 + * Subroutine: first_token (diskfile, ncmax, token) + * Return the first token from the next line of an ASCII file + * Subroutine: next_line (diskfile, ncmax, line) + * Read the next line of an ASCII file and return its length + * Subroutine: stc2s (spchar, string) + * Replace character in string with space + * Subroutine: sts2c (spchar, string) + * Replace spaces in string with character + * Subroutine: istiff (filename) + * Return 1 if file is a readable TIFF graphics file, else 0 + * Subroutine: isjpeg (filename) + * Return 1 if file is a readable JPEG graphics file, else 0 + * int setoken (tokens, string, cwhite) + * Tokenize a string for easy decoding + * int nextoken (tokens, token, maxchars) + * Get next token from tokenized string + * int getoken (tokens, itok, token, maxchars) + * Get specified token from tokenized string + */ + +#include <stdlib.h> +#ifndef VMS +#include <unistd.h> +#endif +#include <stdio.h> +#include <fcntl.h> +#include <sys/file.h> +#include <errno.h> +#include <string.h> +#include "fitsfile.h" +#include <sys/types.h> +#include <sys/stat.h> + + +/* GETFILELINES -- return number of lines in one file */ + +int +getfilelines (filename) + +char *filename; /* Name of file for which to find number of lines */ +{ + + char *buffer, *bufline; + int nlines = 0; + char newline = 10; + + /* Read file */ + buffer = getfilebuff (filename); + + /* Count lines in file */ + if (buffer != NULL) { + bufline = buffer; + nlines = 0; + while ((bufline = strchr (bufline, newline)) != NULL) { + bufline = bufline + 1; + nlines++; + } + free (buffer); + return (nlines); + } + else { + return (0); + } +} + + +/* GETFILEBUFF -- return entire file contents in one character string */ + +char * +getfilebuff (filename) + +char *filename; /* Name of file for which to find number of lines */ +{ + + FILE *diskfile; + int lfile, nr, lbuff, ipt, ibuff; + char *buffer, *newbuff, *nextbuff; + + /* Treat stdin differently */ + if (!strcmp (filename, "stdin")) { + lbuff = 5000; + lfile = lbuff; + buffer = NULL; + ipt = 0; + for (ibuff = 0; ibuff < 10; ibuff++) { + if ((newbuff = realloc (buffer, lfile+1)) != NULL) { + buffer = newbuff; + nextbuff = buffer + ipt; + nr = fread (nextbuff, 1, lbuff, stdin); + if (nr == lbuff) + break; + else { + ipt = ipt + lbuff; + lfile = lfile + lbuff; + } + } + else { + fprintf (stderr,"GETFILEBUFF: No room for %d-byte buffer\n", + lfile); + break; + } + } + return (buffer); + } + + /* Open file */ + if ((diskfile = fopen (filename, "rb")) == NULL) + return (NULL); + + /* Find length of file */ + if (fseek (diskfile, 0, 2) == 0) + lfile = ftell (diskfile); + else + lfile = 0; + if (lfile < 1) { + fprintf (stderr,"GETFILEBUFF: File %s is empty\n", filename); + fclose (diskfile); + return (NULL); + } + + /* Allocate buffer to hold entire file and read it */ + if ((buffer = calloc (1, lfile+1)) != NULL) { + fseek (diskfile, 0, 0); + nr = fread (buffer, 1, lfile, diskfile); + if (nr < lfile) { + fprintf (stderr,"GETFILEBUFF: File %s: read %d / %d bytes\n", + filename, nr, lfile); + free (buffer); + fclose (diskfile); + return (NULL); + } + buffer[lfile] = (char) 0; + fclose (diskfile); + return (buffer); + } + else { + fprintf (stderr,"GETFILEBUFF: File %s: no room for %d-byte buffer\n", + filename, lfile); + fclose (diskfile); + return (NULL); + } +} + + +/* GETFILESIZE -- return size of one file in bytes */ + +int +getfilesize (filename) + +char *filename; /* Name of file for which to find size */ +{ + struct stat statbuff; + + if (stat (filename, &statbuff)) + return (0); + else + return ((int) statbuff.st_size); +} + +int +getfilesize0 (filename) + +char *filename; /* Name of file for which to find size */ +{ + FILE *diskfile; + long filesize; + + /* Open file */ + if ((diskfile = fopen (filename, "rb")) == NULL) + return (-1); + + /* Move to end of the file */ + if (fseek (diskfile, 0, 2) == 0) + + /* Position is the size of the file */ + filesize = ftell (diskfile); + + else + filesize = -1; + + fclose (diskfile); + + return ((int) filesize); +} + + +/* ISIMLIST -- Return 1 if list of FITS or IRAF files, else 0 */ +int +isimlist (filename) + +char *filename; /* Name of possible list file */ +{ + FILE *diskfile; + char token[256]; + int ncmax = 254; + + if ((diskfile = fopen (filename, "r")) == NULL) + return (0); + else { + first_token (diskfile, ncmax, token); + fclose (diskfile); + if (isfits (token) | isiraf (token)) + return (1); + else + return (0); + } +} + + +/* ISIMLISTD -- Return 1 if list of FITS or IRAF files, else 0 */ +int +isimlistd (filename, rootdir) + +char *filename; /* Name of possible list file */ +char *rootdir; /* Name of root directory for files in list */ +{ + FILE *diskfile; + char token[256]; + char filepath[256]; + int ncmax = 254; + + if ((diskfile = fopen (filename, "r")) == NULL) + return (0); + else { + first_token (diskfile, ncmax, token); + fclose (diskfile); + if (rootdir != NULL) { + strcpy (filepath, rootdir); + strcat (filepath, "/"); + strcat (filepath, token); + } + else + strcpy (filepath, token); + if (isfits (filepath) | isiraf (filepath)) + return (1); + else + return (0); + } +} + + +/* ISFILELIST -- Return 1 if list of readable files, else 0 */ +int +isfilelist (filename, rootdir) + +char *filename; /* Name of possible list file */ +char *rootdir; /* Name of root directory for files in list */ +{ + FILE *diskfile; + char token[256]; + char filepath[256]; + int ncmax = 254; + + if ((diskfile = fopen (filename, "r")) == NULL) + return (0); + else { + first_token (diskfile, ncmax, token); + fclose (diskfile); + if (rootdir != NULL) { + strcpy (filepath, rootdir); + strcat (filepath, "/"); + strcat (filepath, token); + } + else + strcpy (filepath, token); + if (isfile (filepath)) + return (1); + else + return (0); + } +} + + +/* ISFILE -- Return 1 if file is a readable file, else 0 */ + +int +isfile (filename) + +char *filename; /* Name of file to check */ +{ + struct stat statbuff; + + if (!strcasecmp (filename, "stdin")) + return (1); + else if (access (filename, R_OK)) + return (0); + else if (stat (filename, &statbuff)) + return (0); + else { + if (S_ISDIR(statbuff.st_mode) && S_IFDIR) + return (2); + else + return (1); + } +} + + +/* NEXT_LINE -- Read the next line of an ASCII file, returning length */ +/* Lines beginning with # are ignored*/ + +int +next_line (diskfile, ncmax, line) + +FILE *diskfile; /* File descriptor for ASCII file */ +int ncmax; /* Maximum number of characters returned */ +char *line; /* Next line (returned) */ +{ + char *lastchar; + + /* If line can be read, add null at the end of the first token */ + if (fgets (line, ncmax, diskfile) != NULL) { + while (line[0] == '#') { + (void) fgets (line, ncmax, diskfile); + } + + /* If only character is a control character, return a NULL string */ + if ((strlen(line)==1) && (line[0]<32)){ + line[0] = (char)0; + return (1); + } + lastchar = line + strlen (line) - 1; + + /* Remove trailing spaces or control characters */ + while (*lastchar <= 32) + *lastchar-- = 0; + + return (strlen (line)); + } + else + return (0); +} + + +/* FIRST_TOKEN -- Return first token from the next line of an ASCII file */ +/* Lines beginning with # are ignored */ + +int +first_token (diskfile, ncmax, token) + +FILE *diskfile; /* File descriptor for ASCII file */ +int ncmax; /* Maximum number of characters returned */ +char *token; /* First token on next line (returned) */ +{ + char *lastchar, *lspace; + + /* If line can be read, add null at the end of the first token */ + if (fgets (token, ncmax, diskfile) != NULL) { + while (token[0] == '#') { + (void) fgets (token, ncmax, diskfile); + } + + /* If only character is a control character, return a NULL */ + if ((strlen(token)==1) && (token[0]<32)){ + token[0]=0; + return (1); + } + lastchar = token + strlen (token) - 1; + + /* Remove trailing spaces or control characters */ + while (*lastchar <= 32) + *lastchar-- = 0; + + if ((lspace = strchr (token, ' ')) != NULL) { + *lspace = (char) 0; + } + return (1); + } + else + return (0); +} + + +/* Replace character in string with space */ + +int +stc2s (spchar, string) + +char *spchar; /* Character to replace with spaces */ +char *string; +{ + int i, lstr, n; + lstr = strlen (string); + n = 0; + for (i = 0; i < lstr; i++) { + if (string[i] == spchar[0]) { + n++; + string[i] = ' '; + } + } + return (n); +} + + +/* Replace spaces in string with character */ + +int +sts2c (spchar, string) + +char *spchar; /* Character with which to replace spaces */ +char *string; +{ + int i, lstr, n; + lstr = strlen (string); + n = 0; + for (i = 0; i < lstr; i++) { + if (string[i] == ' ') { + n++; + string[i] = spchar[0]; + } + } + return (n); +} + + +/* ISTIFF -- Return 1 if TIFF file, else 0 */ +int +istiff (filename) + +char *filename; /* Name of file to check */ +{ + int diskfile; + char keyword[16]; + int nbr; + + /* First check to see if this is an assignment */ + if (strchr (filename, '=')) + return (0); + + /* Check file extension */ + if (strsrch (filename, ".tif") || + strsrch (filename, ".tiff") || + strsrch (filename, ".TIFF") || + strsrch (filename, ".TIF")) + return (1); + + /* If no TIFF file suffix, try opening the file */ + else { + if ((diskfile = open (filename, O_RDONLY)) < 0) + return (0); + else { + nbr = read (diskfile, keyword, 4); + close (diskfile); + if (nbr < 4) + return (0); + else if (!strncmp (keyword, "II", 2)) + return (1); + else if (!strncmp (keyword, "MM", 2)) + return (1); + else + return (0); + } + } +} + + +/* ISJPEG -- Return 1 if JPEG file, else 0 */ +int +isjpeg (filename) + +char *filename; /* Name of file to check */ +{ + int diskfile; + char keyword[16]; + int nbr; + + /* First check to see if this is an assignment */ + if (strchr (filename, '=')) + return (0); + + /* Check file extension */ + if (strsrch (filename, ".jpg") || + strsrch (filename, ".jpeg") || + strsrch (filename, ".JPEG") || + strsrch (filename, ".jfif") || + strsrch (filename, ".jfi") || + strsrch (filename, ".JFIF") || + strsrch (filename, ".JFI") || + strsrch (filename, ".JPG")) + return (1); + + /* If no JPEG file suffix, try opening the file */ + else { + if ((diskfile = open (filename, O_RDONLY)) < 0) + return (0); + else { + nbr = read (diskfile, keyword, 2); + close (diskfile); + if (nbr < 4) + return (0); + else if (keyword[0] == (char) 0xFF && + keyword[1] == (char) 0xD8) + return (1); + else + return (0); + } + } +} + + +/* ISGIF -- Return 1 if GIF file, else 0 */ +int +isgif (filename) + +char *filename; /* Name of file to check */ +{ + int diskfile; + char keyword[16]; + int nbr; + + /* First check to see if this is an assignment */ + if (strchr (filename, '=')) + return (0); + + /* Check file extension */ + if (strsrch (filename, ".gif") || + strsrch (filename, ".GIF")) + return (1); + + /* If no GIF file suffix, try opening the file */ + else { + if ((diskfile = open (filename, O_RDONLY)) < 0) + return (0); + else { + nbr = read (diskfile, keyword, 6); + close (diskfile); + if (nbr < 4) + return (0); + else if (!strncmp (keyword, "GIF", 3)) + return (1); + else + return (0); + } + } +} + + +static int maxtokens = MAXTOKENS; /* Set maximum number of tokens from wcscat.h*/ + +/* -- SETOKEN -- tokenize a string for easy decoding */ + +int +setoken (tokens, string, cwhite) + +struct Tokens *tokens; /* Token structure returned */ +char *string; /* character string to tokenize */ +char *cwhite; /* additional whitespace characters + * if = tab, disallow spaces and commas */ +{ + char squote, dquote, jch, newline; + char *iq, *stri, *wtype, *str0, *inew; + int i,j,naddw, ltok; + + newline = (char) 10; + squote = (char) 39; + dquote = (char) 34; + if (string == NULL) + return (0); + + /* Line is terminated by newline or NULL */ + inew = strchr (string, newline); + if (inew != NULL) + tokens->lline = inew - string - 1; + else + tokens->lline = strlen (string); + + /* Save current line in structure */ + tokens->line = string; + + /* Add extra whitespace characters */ + if (cwhite == NULL) + naddw = 0; + else + naddw = strlen (cwhite); + + /* if character is tab, allow only tabs and nulls as separators */ + if (naddw > 0 && !strncmp (cwhite, "tab", 3)) { + tokens->white[0] = (char) 9; /* Tab */ + tokens->white[1] = (char) 0; /* NULL (end of string) */ + tokens->nwhite = 2; + } + + /* if character is bar, allow only bars and nulls as separators */ + else if (naddw > 0 && !strncmp (cwhite, "bar", 3)) { + tokens->white[0] = '|'; /* Bar */ + tokens->white[1] = (char) 0; /* NULL (end of string) */ + tokens->nwhite = 2; + } + + /* otherwise, allow spaces, tabs, commas, nulls, and cwhite */ + else { + tokens->nwhite = 4 + naddw;; + tokens->white[0] = ' '; /* Space */ + tokens->white[1] = (char) 9; /* Tab */ + tokens->white[2] = ','; /* Comma */ + tokens->white[3] = (char) 124; /* Vertical bar */ + tokens->white[4] = (char) 0; /* Null (end of string) */ + if (tokens->nwhite > 20) + tokens->nwhite = 20; + if (naddw > 0) { + i = 0; + for (j = 4; j < tokens->nwhite; j++) { + tokens->white[j] = cwhite[i]; + i++; + } + } + } + tokens->white[tokens->nwhite] = (char) 0; + + tokens->ntok = 0; + tokens->itok = 0; + iq = string - 1; + for (i = 0; i < maxtokens; i++) { + tokens->tok1[i] = NULL; + tokens->ltok[i] = 0; + } + + /* Process string one character at a time */ + stri = string; + str0 = string; + while (stri < string+tokens->lline) { + + /* Keep stuff between quotes in one token */ + if (stri <= iq) + continue; + jch = *stri; + + /* Handle quoted strings */ + if (jch == squote) + iq = strchr (stri+1, squote); + else if (jch == dquote) + iq = strchr (stri+1, dquote); + else + iq = stri; + if (iq > stri) { + tokens->ntok = tokens->ntok + 1; + if (tokens->ntok > maxtokens) return (maxtokens); + tokens->tok1[tokens->ntok] = stri + 1; + tokens->ltok[tokens->ntok] = (iq - stri) - 1; + stri = iq + 1; + str0 = iq + 1; + continue; + } + + /* Search for unquoted tokens */ + wtype = strchr (tokens->white, jch); + + /* If this is one of the additional whitespace characters, + * pass as a separate token */ + if (wtype > tokens->white + 3) { + + /* Terminate token before whitespace */ + if (stri > str0) { + tokens->ntok = tokens->ntok + 1; + if (tokens->ntok > maxtokens) return (maxtokens); + tokens->tok1[tokens->ntok] = str0; + tokens->ltok[tokens->ntok] = stri - str0; + } + + /* Make whitespace character next token; start new one */ + tokens->ntok = tokens->ntok + 1; + if (tokens->ntok > maxtokens) return (maxtokens); + tokens->tok1[tokens->ntok] = stri; + tokens->ltok[tokens->ntok] = 1; + stri++; + str0 = stri; + } + + /* Pass previous token if regular whitespace or NULL */ + else if (wtype != NULL || jch == (char) 0) { + + /* Ignore leading whitespace */ + if (stri == str0) { + stri++; + str0 = stri; + } + + /* terminate token before whitespace; start new one */ + else { + tokens->ntok = tokens->ntok + 1; + if (tokens->ntok > maxtokens) return (maxtokens); + tokens->tok1[tokens->ntok] = str0; + tokens->ltok[tokens->ntok] = stri - str0; + stri++; + str0 = stri; + } + } + + /* Keep going if not whitespace */ + else + stri++; + } + + /* Add token terminated by end of line */ + if (str0 < stri) { + tokens->ntok = tokens->ntok + 1; + if (tokens->ntok > maxtokens) + return (maxtokens); + tokens->tok1[tokens->ntok] = str0; + ltok = stri - str0 + 1; + tokens->ltok[tokens->ntok] = ltok; + + /* Deal with white space just before end of line */ + jch = str0[ltok-1]; + if (strchr (tokens->white, jch)) { + ltok = ltok - 1; + tokens->ltok[tokens->ntok] = ltok; + tokens->ntok = tokens->ntok + 1; + tokens->tok1[tokens->ntok] = str0 + ltok; + tokens->ltok[tokens->ntok] = 0; + } + } + + tokens->itok = 0; + + return (tokens->ntok); +} + + +/* NEXTOKEN -- get next token from tokenized string */ + +int +nextoken (tokens, token, maxchars) + +struct Tokens *tokens; /* Token structure returned */ +char *token; /* token (returned) */ +int maxchars; /* Maximum length of token */ +{ + int ltok; /* length of token string (returned) */ + int it, i; + int maxc = maxchars - 1; + + tokens->itok = tokens->itok + 1; + it = tokens->itok; + if (it > tokens->ntok) + it = tokens->ntok; + else if (it < 1) + it = 1; + ltok = tokens->ltok[it]; + if (ltok > maxc) + ltok = maxc; + strncpy (token, tokens->tok1[it], ltok); + for (i = ltok; i < maxc; i++) + token[i] = (char) 0; + return (ltok); +} + + +/* GETOKEN -- get specified token from tokenized string */ + +int +getoken (tokens, itok, token, maxchars) + +struct Tokens *tokens; /* Token structure returned */ +int itok; /* token sequence number of token + * if <0, get whole string after token -itok + * if =0, get whole string */ +char *token; /* token (returned) */ +int maxchars; /* Maximum length of token */ +{ + int ltok; /* length of token string (returned) */ + int it, i; + int maxc = maxchars - 1; + + it = itok; + if (it > 0 ) { + if (it > tokens->ntok) + it = tokens->ntok; + ltok = tokens->ltok[it]; + if (ltok > maxc) + ltok = maxc; + strncpy (token, tokens->tok1[it], ltok); + } + else if (it < 0) { + if (it < -tokens->ntok) + it = -tokens->ntok; + ltok = tokens->line + tokens->lline - tokens->tok1[-it]; + if (ltok > maxc) + ltok = maxc; + strncpy (token, tokens->tok1[-it], ltok); + } + else { + ltok = tokens->lline; + if (ltok > maxc) + ltok = maxc; + strncpy (token, tokens->tok1[1], ltok); + } + for (i = ltok; i < maxc; i++) + token[i] = (char) 0; + + return (ltok); +} + +/* + * Jul 14 1999 New subroutines + * Jul 15 1999 Add getfilebuff() + * Oct 15 1999 Fix format eror in error message + * Oct 21 1999 Fix declarations after lint + * Dec 9 1999 Add next_token(); set pointer to next token in first_token + * + * Sep 25 2001 Add isfilelist(); move isfile() from catutil.c + * + * Jan 4 2002 Allow getfilebuffer() to read from stdin + * Jan 8 2002 Add sts2c() and stc2s() for space-replaced strings + * Mar 22 2002 Clean up isfilelist() + * Aug 1 2002 Return 1 if file is stdin in isfile() + * + * Feb 4 2003 Open catalog file rb instead of r (Martin Ploner, Bern) + * Mar 5 2003 Add isimlistd() to check image lists with root directory + * May 27 2003 Use file stat call in getfilesize() instead of opening file + * Jul 17 2003 Add root directory argument to isfilelist() + * + * Sep 29 2004 Drop next_token() to avoid conflict with subroutine in catutil.c + * + * Sep 26 2005 In first_token, return NULL if token is only control character + * + * Feb 23 2006 Add istiff(), isjpeg(), isgif() to check TIFF, JPEG, GIF files + * Jun 20 2006 Cast call to fgets() void + * + * Jan 5 2007 Change stc2s() and sts2c() to pass single character as pointer + * Jan 11 2007 Move token access subroutines from catutil.c + * + * Aug 28 2014 Return length from next_line(): 0=unsuccessful + */ diff --git a/tksao/wcssubs/fitsfile.c b/tksao/wcssubs/fitsfile.c new file mode 100644 index 0000000..c832687 --- /dev/null +++ b/tksao/wcssubs/fitsfile.c @@ -0,0 +1,2325 @@ +/*** File libwcs/fitsfile.c + *** July 25, 2014 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2014 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: fitsfile.c (FITS file reading and writing) + * Purpose: Read and write FITS image and table files + * fitsropen (inpath) + * Open a FITS file for reading, returning a FILE pointer + * fitsrhead (filename, lhead, nbhead) + * Read FITS header and return it + * fitsrtail (filename, lhead, nbhead) + * Read appended FITS header and return it + * fitsrsect (filename, nbhead, header, fd, x0, y0, nx, ny) + * Read section of a FITS image, having already read the header + * fitsrimage (filename, nbhead, header) + * Read FITS image, having already ready the header + * fitsrfull (filename, nbhead, header) + * Read a FITS image of any dimension + * fitsrtopen (inpath, nk, kw, nrows, nchar, nbhead) + * Open a FITS table file for reading; return header information + * fitsrthead (header, nk, kw, nrows, nchar, nbhead) + * Extract FITS table information from a FITS header + * fitsrtline (fd, nbhead, lbuff, tbuff, irow, nbline, line) + * Read next line of FITS table file + * ftgetr8 (entry, kw) + * Extract column from FITS table line as double + * ftgetr4 (entry, kw) + * Extract column from FITS table line as float + * ftgeti4 (entry, kw) + * Extract column from FITS table line as int + * ftgeti2 (entry, kw) + * Extract column from FITS table line as short + * ftgetc (entry, kw, string, maxchar) + * Extract column from FITS table line as a character string + * fitswimage (filename, header, image) + * Write FITS header and image + * fitswext (filename, header, image) + * Write FITS header and image as extension to existing FITS file + * fitswhdu (fd, filename, header, image) + * Write FITS header and image as extension to file descriptor + * fitscimage (filename, header, filename0) + * Write FITS header and copy FITS image + * fitswhead (filename, header) + * Write FITS header and keep file open for further writing + * fitswexhead (filename, header) + * Write FITS header only to FITS extension without writing data + * isfits (filename) + * Return 1 if file is a FITS file, else 0 + * fitsheadsize (header) + * Return size of FITS header in bytes + */ + +#include <stdlib.h> +#ifndef VMS +#include <unistd.h> +#endif +#include <stdio.h> +#include <fcntl.h> +#include <sys/file.h> +#include <errno.h> +#include <string.h> +#include "fitsfile.h" + +static int verbose=0; /* Print diagnostics */ +static char fitserrmsg[80]; +static int fitsinherit = 1; /* Append primary header to extension header */ +void +setfitsinherit (inh) +int inh; +{fitsinherit = inh; return;} + +static off_t ibhead = 0; /* Number of bytes read before header starts */ + +off_t +getfitsskip() +{return (ibhead);} + +/* FITSRHEAD -- Read a FITS header */ + +char * +fitsrhead (filename, lhead, nbhead) + +char *filename; /* Name of FITS image file */ +int *lhead; /* Allocated length of FITS header in bytes (returned) */ +int *nbhead; /* Number of bytes before start of data (returned) */ + /* This includes all skipped image extensions */ + +{ + int fd; + char *header; /* FITS image header (filled) */ + int extend; + int nbytes,naxis, i; + int ntry,nbr,irec,nrec, nbh, ipos, npos, nbprim, lprim, lext; + int nax1, nax2, nax3, nax4, nbpix, ibpix, nblock, nbskip; + char fitsbuf[2884]; + char *headend; /* Pointer to last line of header */ + char *headnext; /* Pointer to next line of header to be added */ + int hdu; /* header/data unit counter */ + int extnum; /* desired header data number + (0=primary -1=first with data -2=use EXTNAME) */ + char extname[32]; /* FITS extension name */ + char extnam[32]; /* Desired FITS extension name */ + char *ext; /* FITS extension name or number in header, if any */ + char *pheader; /* Primary header (naxis is 0) */ + char cext = 0; + char *rbrac; /* Pointer to right bracket if present in file name */ + char *mwcs; /* Pointer to WCS name separated by % */ + char *newhead; /* New larger header */ + int nbh0; /* Length of old too small header */ + char *pheadend; + int inherit = 1; /* Value of INHERIT keyword in FITS extension header */ + int extfound = 0; /* Set to one if desired FITS extension is found */ + int npcount; + + pheader = NULL; + lprim = 0; + header = NULL; + + /* Check for FITS WCS specification and ignore for file opening */ + mwcs = strchr (filename, '%'); + if (mwcs != NULL) + *mwcs = (char) 0; + + /* Check for FITS extension and ignore for file opening */ + rbrac = NULL; + ext = strchr (filename, ','); + if (ext == NULL) { + ext = strchr (filename, '['); + if (ext != NULL) { + rbrac = strchr (filename, ']'); + if (rbrac != NULL) + *rbrac = (char) 0; + } + } + if (ext != NULL) { + cext = *ext; + *ext = (char) 0; + } + + /* Open the image file and read the header */ + if (strncasecmp (filename,"stdin",5)) { + fd = -1; + fd = fitsropen (filename); + } +#ifndef VMS + else { + fd = STDIN_FILENO; + extnum = -1; + } +#endif + + if (ext != NULL) { + if (isnum (ext+1)) + extnum = atoi (ext+1); + else { + extnum = -2; + strcpy (extnam, ext+1); + } + } + else + extnum = -1; + + /* Repair the damage done to the file-name string during parsing */ + if (ext != NULL) + *ext = cext; + if (rbrac != NULL) + *rbrac = ']'; + if (mwcs != NULL) + *mwcs = '%'; + + if (fd < 0) { + fprintf (stderr,"FITSRHEAD: cannot read file %s\n", filename); + return (NULL); + } + + nbytes = FITSBLOCK; + *nbhead = 0; + headend = NULL; + nbh = FITSBLOCK * 20 + 4; + header = (char *) calloc ((unsigned int) nbh, 1); + (void) hlength (header, nbh); + headnext = header; + nrec = 1; + hdu = 0; + ibhead = 0; + + /* Read FITS header from input file one FITS block at a time */ + irec = 0; + ibhead = 0; + while (irec < 500) { + nbytes = FITSBLOCK; + for (ntry = 0; ntry < 10; ntry++) { + for (i = 0; i < 2884; i++) fitsbuf[i] = 0; + nbr = read (fd, fitsbuf, nbytes); + if (verbose) + fprintf (stderr,"FITSRHEAD: %d header bytes read\n",nbr); + + /* Short records allowed only if they have the last header line */ + if (nbr < nbytes) { + headend = ksearch (fitsbuf,"END"); + if (headend == NULL) { + if (ntry < 9) { + if (verbose) + fprintf (stderr,"FITSRHEAD: %d / %d bytes read %d\n", + nbr,nbytes,ntry); + } + else { + snprintf(fitserrmsg,79,"FITSRHEAD: '%d / %d bytes of header read from %s\n" + ,nbr,nbytes,filename); +#ifndef VMS + if (fd != STDIN_FILENO) +#endif + (void)close (fd); + free (header); + /* if (pheader != NULL) + return (pheader); */ + if (extnum != -1 && !extfound) { + *ext = (char) 0; + if (extnum < 0) { + snprintf (fitserrmsg,79, + "FITSRHEAD: Extension %s not found in file %s", + extnam, filename); + } + else { + snprintf (fitserrmsg,79, + "FITSRHEAD: Extension %d not found in file %s", + extnum, filename); + } + *ext = cext; + } + else if (hdu > 0) { + snprintf (fitserrmsg,79, + "FITSRHEAD: No extensions found in file %s", filename); + hdu = 0; + if (pheader != NULL) { + *lhead = nbprim; + *nbhead = nbprim; + return (pheader); + } + break; + } + else { + snprintf (fitserrmsg,79, + "FITSRHEAD: No header found in file %s", filename); + } + return (NULL); + } + } + else + break; + } + else + break; + } + + /* Replace control characters and nulls with spaces */ + for (i = 0; i < 2880; i++) + if (fitsbuf[i] < 32 || i > nbr) fitsbuf[i] = 32; + if (nbr < 2880) + nbr = 2880; + + /* Move current FITS record into header string */ + strncpy (headnext, fitsbuf, nbr); + *nbhead = *nbhead + nbr; + nrec = nrec + 1; + *(headnext+nbr+1) = 0; + ibhead = ibhead + 2880; + if (verbose) + fprintf (stderr,"FITSRHEAD: %d bytes in header\n",ibhead); + + /* Check to see if this is the final record in this header */ + headend = ksearch (fitsbuf,"END"); + if (headend == NULL) { + + /* Double size of header buffer if too small */ + if (nrec * FITSBLOCK > nbh) { + nbh0 = nbh - 4; + nbh = (nrec * 2 * FITSBLOCK) + 4; + newhead = (char *) calloc (1,(unsigned int) nbh); + if (newhead) { + for (i = 0; i < nbh0; i++) + newhead[i] = header[i]; + free (header); + newhead[nbh-3] = (char) 0; + header = newhead; + (void) hlength (header, nbh); + headnext = header + ((nrec-1) * FITSBLOCK); + } + else { + fprintf (stderr,"FITSRHEAD: %d bytes cannot be allocated for header\n",nbh); + exit (1); + } + } + else + headnext = headnext + FITSBLOCK; + } + + else { + naxis = 0; + hgeti4 (header,"NAXIS",&naxis); + + /* If header has no data, save it for appending to desired header */ + if (naxis < 1) { + nbprim = nrec * FITSBLOCK; + headend = ksearch (header,"END"); + lprim = headend + 80 - header; + pheader = (char *) calloc ((unsigned int) nbprim, 1); + for (i = 0; i < lprim; i++) + pheader[i] = header[i]; + for (i = lprim; i < nbprim; i++) + pheader[i] = ' '; + } + + /* If header has no data, start with the next record */ + if (naxis < 1 && extnum == -1) { + extend = 0; + hgetl (header,"EXTEND",&extend); + if (naxis == 0 && extend) { + headnext = header; + *headend = ' '; + headend = NULL; + nrec = 1; + hdu = hdu + 1; + } + else { + break; + } + } + + /* If this is the desired header data unit, keep it */ + else if (extnum != -1) { + if (extnum > -1 && hdu == extnum) { + extfound = 1; + break; + } + else if (extnum < 0) { + extname[0] = 0; + hgets (header, "EXTNAME", 32, extname); + if (!strcmp (extnam,extname)) { + extfound = 1; + break; + } + } + + /* If this is not desired header data unit, skip over data */ + hdu = hdu + 1; + nblock = 0; + ibhead = 0; + if (naxis > 0) { + ibpix = 0; + hgeti4 (header,"BITPIX",&ibpix); + if (ibpix < 0) { + nbpix = -ibpix / 8; + } + else { + nbpix = ibpix / 8; + } + nax1 = 1; + hgeti4 (header,"NAXIS1",&nax1); + nax2 = 1; + if (naxis > 1) { + hgeti4 (header,"NAXIS2",&nax2); + } + nax3 = 1; + if (naxis > 2) { + hgeti4 (header,"NAXIS3",&nax3); + } + nax4 = 1; + if (naxis > 3) { + hgeti4 (header,"NAXIS4",&nax4); + } + nbskip = nax1 * nax2 * nax3 * nax4 * nbpix; + nblock = nbskip / 2880; + if (nblock*2880 < nbskip) { + nblock = nblock + 1; + } + npcount = 0; + hgeti4 (header,"PCOUNT", &npcount); + if (npcount > 0) { + nbskip = nbskip + npcount; + nblock = nbskip / 2880; + if (nblock*2880 < nbskip) + nblock = nblock + 1; + } + } + else { + nblock = 0; + } + *nbhead = *nbhead + (nblock * 2880); + + /* Set file pointer to beginning of next header/data unit */ + if (nblock > 0) { +#ifndef VMS + if (fd != STDIN_FILENO) { + ipos = lseek (fd, *nbhead, SEEK_SET); + npos = *nbhead; + } + else { +#else + { +#endif + ipos = 0; + for (i = 0; i < nblock; i++) { + nbytes = FITSBLOCK; + nbr = read (fd, fitsbuf, nbytes); + if (nbr < nbytes) { + ipos = ipos + nbr; + break; + } + else { + ipos = ipos + nbytes; + } + } + npos = nblock * 2880; + } + if (ipos < npos) { + snprintf (fitserrmsg,79,"FITSRHEAD: %d / %d bytes skipped\n", + ipos,npos); + extfound = 0; + break; + } + } + headnext = header; + headend = NULL; + nrec = 1; + } + else { + break; + } + } + } + +#ifndef VMS + if (fd != STDIN_FILENO) + (void)close (fd); +#endif + +/* Print error message and return null if extension not found */ + if (extnum != -1 && !extfound) { + if (extnum < 0) + fprintf (stderr, "FITSRHEAD: Extension %s not found in file %s\n",extnam, filename); + else + fprintf (stderr, "FITSRHEAD: Extension %d not found in file %s\n",extnum, filename); + if (pheader != NULL) { + free (pheader); + pheader = NULL; + } + return (NULL); + } + + /* Allocate an extra block for good measure */ + *lhead = (nrec + 1) * FITSBLOCK; + if (*lhead > nbh) { + newhead = (char *) calloc (1,(unsigned int) *lhead); + for (i = 0; i < nbh; i++) + newhead[i] = header[i]; + free (header); + header = newhead; + (void) hlength (header, *lhead); + } + else + *lhead = nbh; + + /* If INHERIT keyword is FALSE, never append primary header */ + if (hgetl (header, "INHERIT", &inherit)) { + if (!inherit && fitsinherit) + fitsinherit = 0; + } + + /* Append primary data header to extension header */ + if (pheader != NULL && extnum != 0 && fitsinherit && hdu > 0) { + extname[0] = 0; + hgets (header, "XTENSION", 32, extname); + if (!strcmp (extname,"IMAGE")) { + strncpy (header, "SIMPLE ", 8); + hputl (header, "SIMPLE", 1); + } + headend = blsearch (header,"END"); + if (headend == NULL) + headend = ksearch (header, "END"); + lext = headend - header; + + /* Update primary header for inclusion at end of extension header */ + hchange (pheader, "SIMPLE", "ROOTHEAD"); + hchange (pheader, "NEXTEND", "NUMEXT"); + hdel (pheader, "BITPIX"); + hdel (pheader, "NAXIS"); + hdel (pheader, "EXTEND"); + hputl (pheader, "ROOTEND",1); + pheadend = ksearch (pheader,"END"); + lprim = pheadend + 320 - pheader; + if (lext + lprim > nbh) { + nrec = (lext + lprim) / FITSBLOCK; + if (FITSBLOCK*nrec < lext+lprim) + nrec = nrec + 1; + *lhead = (nrec+1) * FITSBLOCK; + newhead = (char *) calloc (1,(unsigned int) *lhead); + for (i = 0; i < nbh; i++) + newhead[i] = header[i]; + free (header); + header = newhead; + headend = header + lext; + (void) hlength (header, *lhead); + } + hputs (header,"COMMENT","-------------------------------------------"); + hputs (header,"COMMENT","Information from Primary Header"); + hputs (header,"COMMENT","-------------------------------------------"); + headend = blsearch (header,"END"); + if (headend == NULL) + headend = ksearch (header, "END"); + pheader[lprim] = 0; + strncpy (headend, pheader, lprim); + if (pheader != NULL) { + free (pheader); + pheader = NULL; + } + } + + ibhead = *nbhead - ibhead; + + return (header); +} + + +/* FITSRTAIL -- Read FITS header appended to graphics file */ + +char * +fitsrtail (filename, lhead, nbhead) + +char *filename; /* Name of image file */ +int *lhead; /* Allocated length of FITS header in bytes (returned) */ +int *nbhead; /* Number of bytes before start of data (returned) */ + /* This includes all skipped image extensions */ + +{ + int fd; + char *header; /* FITS image header (filled) */ + int nbytes, i, ndiff; + int nbr, irec; + off_t offset; + char *mwcs; /* Pointer to WCS name separated by % */ + char *headstart; + char *newhead; + + header = NULL; + + /* Check for FITS WCS specification and ignore for file opening */ + mwcs = strchr (filename, '%'); + if (mwcs != NULL) + *mwcs = (char) 0; + + /* Open the image file and read the header */ + if (strncasecmp (filename,"stdin",5)) { + fd = -1; + fd = fitsropen (filename); + } +#ifndef VMS + else { + fd = STDIN_FILENO; + } +#endif + + /* Repair the damage done to the file-name string during parsing */ + if (mwcs != NULL) + *mwcs = '%'; + + if (fd < 0) { + fprintf (stderr,"FITSRTAIL: cannot read file %s\n", filename); + return (NULL); + } + + nbytes = FITSBLOCK; + *nbhead = 0; + *lhead = 0; + + /* Read FITS header from end of input file one FITS block at a time */ + irec = 0; + while (irec < 100) { + nbytes = FITSBLOCK * (irec + 2); + header = (char *) calloc ((unsigned int) nbytes, 1); + offset = lseek (fd, -nbytes, SEEK_END); + if (offset < 0) { + free (header); + header = NULL; + nbytes = 0; + break; + } + for (i = 0; i < nbytes; i++) header[i] = 0; + nbr = read (fd, header, nbytes); + + /* Check for SIMPLE at start of header */ + for (i = 0; i < nbr; i++) + if (header[i] < 32) header[i] = 32; + if ((headstart = ksearch (header,"SIMPLE"))) { + if (headstart != header) { + ndiff = headstart - header; + newhead = (char *) calloc ((unsigned int) nbytes, 1); + for (i = 0; i < nbytes-ndiff; i++) + newhead[i] = headstart[i]; + free (header); + header = newhead; + } + *lhead = nbytes; + *nbhead = nbytes; + break; + } + free (header); + } + (void) hlength (header, nbytes); + +#ifndef VMS + if (fd != STDIN_FILENO) + (void)close (fd); +#endif + + return (header); +} + + +/* FITSRSECT -- Read a piece of a FITS image, having already read the header */ + +char * +fitsrsect (filename, header, nbhead, x0, y0, nx, ny, nlog) + +char *filename; /* Name of FITS image file */ +char *header; /* FITS header for image (previously read) */ +int nbhead; /* Actual length of image header(s) in bytes */ +int x0, y0; /* FITS image coordinate of first pixel */ +int nx; /* Number of columns to read (less than NAXIS1) */ +int ny; /* Number of rows to read (less than NAXIS2) */ +int nlog; /* Note progress mod this rows */ +{ + int fd; /* File descriptor */ + int nbimage, naxis1, naxis2, bytepix, nbread; + int bitpix, naxis, nblocks, nbytes, nbr; + int x1, y1, nbline, nyleft; + off_t impos, nblin; + char *image, *imline, *imlast; + int ilog = 0; + int row; + + /* Open the image file and read the header */ + if (strncasecmp (filename,"stdin", 5)) { + fd = -1; + + fd = fitsropen (filename); + if (fd < 0) { + snprintf (fitserrmsg,79, "FITSRSECT: cannot read file %s\n", filename); + return (NULL); + } + + /* Skip over FITS header and whatever else needs to be skipped */ + if (lseek (fd, nbhead, SEEK_SET) < 0) { + (void)close (fd); + snprintf (fitserrmsg,79, "FITSRSECT: cannot skip header of file %s\n", + filename); + return (NULL); + } + } +#ifndef VMS + else + fd = STDIN_FILENO; +#endif + + /* Compute size of image in bytes using relevant header parameters */ + naxis = 1; + hgeti4 (header,"NAXIS",&naxis); + naxis1 = 1; + hgeti4 (header,"NAXIS1",&naxis1); + naxis2 = 1; + hgeti4 (header,"NAXIS2",&naxis2); + bitpix = 0; + hgeti4 (header,"BITPIX",&bitpix); + if (bitpix == 0) { + /* snprintf (fitserrmsg,79, "FITSRSECT: BITPIX is 0; image not read\n"); */ + (void)close (fd); + return (NULL); + } + bytepix = bitpix / 8; + if (bytepix < 0) bytepix = -bytepix; + + /* Keep X coordinates within image limits */ + if (x0 < 1) + x0 = 1; + else if (x0 > naxis1) + x0 = naxis1; + x1 = x0 + nx - 1; + if (x1 < 1) + x1 = 1; + else if (x1 > naxis1) + x1 = naxis1; + nx = x1 - x0 + 1; + + /* Keep Y coordinates within image limits */ + if (y0 < 1) + y0 = 1; + else if (y0 > naxis2) + y0 = naxis2; + y1 = y0 + ny - 1; + if (y1 < 1) + y1 = 1; + else if (y1 > naxis2) + y1 = naxis2; + ny = y1 - y0 + 1; + + /* Number of bytes in output image */ + nbline = nx * bytepix; + nbimage = nbline * ny; + + /* Set number of bytes to integral number of 2880-byte blocks */ + nblocks = nbimage / FITSBLOCK; + if (nblocks * FITSBLOCK < nbimage) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Allocate image section to be read */ + image = (char *) malloc (nbytes); + nyleft = ny; + imline = image; + nbr = 0; + + /* Computer pointer to first byte of input image to read */ + nblin = naxis1 * bytepix; + impos = ((y0 - 1) * nblin) + ((x0 - 1) * bytepix); + row = y0 - 1; + + /* Read image section one line at a time */ + while (nyleft-- > 0) { + if (lseek (fd, impos, SEEK_CUR) >= 0) { + nbread = read (fd, imline, nbline); + nbr = nbr + nbread; + impos = nblin - nbread; + imline = imline + nbline; + row++; + if (++ilog == nlog) { + ilog = 0; + fprintf (stderr, "Row %5d extracted ", row); + (void) putc (13,stderr); + } + } + } + if (nlog) + fprintf (stderr, "\n"); + + /* Fill rest of image with zeroes */ + imline = image + nbimage; + imlast = image + nbytes; + while (imline++ < imlast) + *imline = (char) 0; + + /* Byte-reverse image, if necessary */ + if (imswapped ()) + imswap (bitpix, image, nbytes); + + return (image); +} + + +/* FITSRIMAGE -- Read a FITS image */ + +char * +fitsrimage (filename, nbhead, header) + +char *filename; /* Name of FITS image file */ +int nbhead; /* Actual length of image header(s) in bytes */ +char *header; /* FITS header for image (previously read) */ +{ + int fd; + int nbimage, naxis1, naxis2, bytepix, nbread; + int bitpix, naxis, nblocks, nbytes, nbleft, nbr; + int simple; + char *image, *imleft; + + /* Open the image file and read the header */ + if (strncasecmp (filename,"stdin", 5)) { + fd = -1; + + fd = fitsropen (filename); + if (fd < 0) { + snprintf (fitserrmsg,79, "FITSRIMAGE: cannot read file %s\n", filename); + return (NULL); + } + + /* Skip over FITS header and whatever else needs to be skipped */ + if (lseek (fd, nbhead, SEEK_SET) < 0) { + (void)close (fd); + snprintf (fitserrmsg,79, "FITSRIMAGE: cannot skip header of file %s\n", + filename); + return (NULL); + } + } +#ifndef VMS + else + fd = STDIN_FILENO; +#endif + + /* If SIMPLE=F in header, simply put post-header part of file in buffer */ + hgetl (header, "SIMPLE", &simple); + if (!simple) { + nbytes = getfilesize (filename) - nbhead; + if ((image = (char *) malloc (nbytes + 1)) == NULL) { + /* snprintf (fitserrmsg,79, "FITSRIMAGE: %d-byte image buffer cannot be allocated\n"); */ + (void)close (fd); + return (NULL); + } + hputi4 (header, "NBDATA", nbytes); + nbread = read (fd, image, nbytes); + return (image); + } + + /* Compute size of image in bytes using relevant header parameters */ + naxis = 1; + hgeti4 (header,"NAXIS",&naxis); + naxis1 = 1; + hgeti4 (header,"NAXIS1",&naxis1); + naxis2 = 1; + hgeti4 (header,"NAXIS2",&naxis2); + bitpix = 0; + hgeti4 (header,"BITPIX",&bitpix); + if (bitpix == 0) { + /* snprintf (fitserrmsg,79, "FITSRIMAGE: BITPIX is 0; image not read\n"); */ + (void)close (fd); + return (NULL); + } + bytepix = bitpix / 8; + if (bytepix < 0) bytepix = -bytepix; + + /* If either dimension is one and image is 3-D, read all three dimensions */ + if (naxis == 3 && (naxis1 ==1 || naxis2 == 1)) { + int naxis3; + hgeti4 (header,"NAXIS3",&naxis3); + nbimage = naxis1 * naxis2 * naxis3 * bytepix; + } + else + nbimage = naxis1 * naxis2 * bytepix; + + /* Set number of bytes to integral number of 2880-byte blocks */ + nblocks = nbimage / FITSBLOCK; + if (nblocks * FITSBLOCK < nbimage) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Allocate and read image */ + image = (char *) malloc (nbytes); + nbleft = nbytes; + imleft = image; + nbr = 0; + while (nbleft > 0) { + nbread = read (fd, imleft, nbleft); + nbr = nbr + nbread; +#ifndef VMS + if (fd == STDIN_FILENO && nbread < nbleft && nbread > 0) { + nbleft = nbleft - nbread; + imleft = imleft + nbread; + } + else +#endif + nbleft = 0; + } +#ifndef VMS + if (fd != STDIN_FILENO) + (void)close (fd); +#endif + if (nbr < nbimage) { + snprintf (fitserrmsg,79, "FITSRIMAGE: %d of %d bytes read from file %s\n", + nbr, nbimage, filename); + return (NULL); + } + + /* Byte-reverse image, if necessary */ + if (imswapped ()) + imswap (bitpix, image, nbytes); + + return (image); +} + + +/* FITSRFULL -- Read a FITS image of any dimension */ + +char * +fitsrfull (filename, nbhead, header) + +char *filename; /* Name of FITS image file */ +int nbhead; /* Actual length of image header(s) in bytes */ +char *header; /* FITS header for image (previously read) */ +{ + int fd; + int nbimage, naxisi, iaxis, bytepix, nbread; + int bitpix, naxis, nblocks, nbytes, nbleft, nbr, simple; + char keyword[16]; + char *image, *imleft; + + /* Open the image file and read the header */ + if (strncasecmp (filename,"stdin", 5)) { + fd = -1; + + fd = fitsropen (filename); + if (fd < 0) { + snprintf (fitserrmsg,79, "FITSRFULL: cannot read file %s\n", filename); + return (NULL); + } + + /* Skip over FITS header and whatever else needs to be skipped */ + if (lseek (fd, nbhead, SEEK_SET) < 0) { + (void)close (fd); + snprintf (fitserrmsg,79, "FITSRFULL: cannot skip header of file %s\n", + filename); + return (NULL); + } + } +#ifndef VMS + else + fd = STDIN_FILENO; +#endif + + /* If SIMPLE=F in header, simply put post-header part of file in buffer */ + hgetl (header, "SIMPLE", &simple); + if (!simple) { + nbytes = getfilesize (filename) - nbhead; + if ((image = (char *) malloc (nbytes + 1)) == NULL) { + snprintf (fitserrmsg,79, "FITSRFULL: %d-byte image buffer cannot be allocated\n",nbytes+1); + (void)close (fd); + return (NULL); + } + hputi4 (header, "NBDATA", nbytes); + nbread = read (fd, image, nbytes); + return (image); + } + + /* Find number of bytes per pixel */ + bitpix = 0; + hgeti4 (header,"BITPIX",&bitpix); + if (bitpix == 0) { + snprintf (fitserrmsg,79, "FITSRFULL: BITPIX is 0; image not read\n"); + (void)close (fd); + return (NULL); + } + bytepix = bitpix / 8; + if (bytepix < 0) bytepix = -bytepix; + nbimage = bytepix; + + /* Compute size of image in bytes using relevant header parameters */ + naxis = 1; + hgeti4 (header,"NAXIS",&naxis); + for (iaxis = 1; iaxis <= naxis; iaxis++) { + sprintf (keyword, "NAXIS%d", iaxis); + naxisi = 1; + hgeti4 (header,keyword,&naxisi); + nbimage = nbimage * naxisi; + } + + /* Set number of bytes to integral number of 2880-byte blocks */ + nblocks = nbimage / FITSBLOCK; + if (nblocks * FITSBLOCK < nbimage) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Allocate and read image */ + image = (char *) malloc (nbytes); + nbleft = nbytes; + imleft = image; + nbr = 0; + while (nbleft > 0) { + nbread = read (fd, imleft, nbleft); + nbr = nbr + nbread; +#ifndef VMS + if (fd == STDIN_FILENO && nbread < nbleft && nbread > 0) { + nbleft = nbleft - nbread; + imleft = imleft + nbread; + } + else +#endif + nbleft = 0; + } +#ifndef VMS + if (fd != STDIN_FILENO) + (void)close (fd); +#endif + if (nbr < nbimage) { + snprintf (fitserrmsg,79, "FITSRFULL: %d of %d image bytes read from file %s\n", + nbr, nbimage, filename); + return (NULL); + } + + /* Byte-reverse image, if necessary */ + if (imswapped ()) + imswap (bitpix, image, nbytes); + + return (image); +} + + +/* FITSROPEN -- Open a FITS file, returning the file descriptor */ + +int +fitsropen (inpath) + +char *inpath; /* Pathname for FITS tables file to read */ + +{ + int ntry; + int fd; /* file descriptor for FITS tables file (returned) */ + char *ext; /* extension name or number */ + char cext = 0; + char *rbrac; + char *mwcs; /* Pointer to WCS name separated by % */ + +/* Check for FITS WCS specification and ignore for file opening */ + mwcs = strchr (inpath, '%'); + +/* Check for FITS extension and ignore for file opening */ + ext = strchr (inpath, ','); + rbrac = NULL; + if (ext == NULL) { + ext = strchr (inpath, '['); + if (ext != NULL) { + rbrac = strchr (inpath, ']'); + } + } + +/* Open input file */ + for (ntry = 0; ntry < 3; ntry++) { + if (ext != NULL) { + cext = *ext; + *ext = 0; + } + if (rbrac != NULL) + *rbrac = (char) 0; + if (mwcs != NULL) + *mwcs = (char) 0; + fd = open (inpath, O_RDONLY); + if (ext != NULL) + *ext = cext; + if (rbrac != NULL) + *rbrac = ']'; + if (mwcs != NULL) + *mwcs = '%'; + if (fd >= 0) + break; + else if (ntry == 2) { + snprintf (fitserrmsg,79, "FITSROPEN: cannot read file %s\n", inpath); + return (-1); + } + } + + if (verbose) + fprintf (stderr,"FITSROPEN: input file %s opened\n",inpath); + + return (fd); +} + + +static int offset1=0; +static int offset2=0; + +/* FITSRTOPEN -- Open FITS table file and fill structure with + * pointers to selected keywords + * Return file descriptor (-1 if unsuccessful) + */ + +int +fitsrtopen (inpath, nk, kw, nrows, nchar, nbhead) + +char *inpath; /* Pathname for FITS tables file to read */ +int *nk; /* Number of keywords to use */ +struct Keyword **kw; /* Structure for desired entries */ +int *nrows; /* Number of rows in table (returned) */ +int *nchar; /* Number of characters in one table row (returned) */ +int *nbhead; /* Number of characters before table starts */ + +{ + char temp[16]; + int fd; + int lhead; /* Maximum length in bytes of FITS header */ + char *header; /* Header for FITS tables file to read */ + +/* Read FITS header from input file */ + header = fitsrhead (inpath, &lhead, nbhead); + if (!header) { + snprintf (fitserrmsg,79,"FITSRTOPEN: %s is not a FITS file\n",inpath); + return (0); + } + +/* Make sure this file is really a FITS table file */ + temp[0] = 0; + (void) hgets (header,"XTENSION",16,temp); + if (strlen (temp) == 0) { + snprintf (fitserrmsg,79, + "FITSRTOPEN: %s is not a FITS table file\n",inpath); + free ((void *) header); + return (0); + } + +/* If it is a FITS file, get table information from the header */ + else if (!strcmp (temp, "TABLE") || !strcmp (temp, "BINTABLE")) { + if (fitsrthead (header, nk, kw, nrows, nchar)) { + snprintf (fitserrmsg,79, + "FITSRTOPEN: Cannot read FITS table from %s\n",inpath); + free ((void *) header); + return (-1); + } + else { + fd = fitsropen (inpath); + offset1 = 0; + offset2 = 0; + free ((void *) header); + return (fd); + } + } + +/* If it is another FITS extension note it and return */ + else { + snprintf (fitserrmsg,79, + "FITSRTOPEN: %s is a %s extension, not table\n", + inpath, temp); + free ((void *) header); + return (0); + } +} + +static struct Keyword *pw; /* Structure for all entries */ +static int *lpnam; /* length of name for each field */ +static int bfields = 0; + +/* FITSRTHEAD -- From FITS table header, read pointers to selected keywords */ + +int +fitsrthead (header, nk, kw, nrows, nchar) + +char *header; /* Header for FITS tables file to read */ +int *nk; /* Number of keywords to use */ +struct Keyword **kw; /* Structure for desired entries */ +int *nrows; /* Number of rows in table (returned) */ +int *nchar; /* Number of characters in one table row (returned) */ + +{ + struct Keyword *rw; /* Structure for desired entries */ + int nfields; + int ifield, ik, i, ikf, ltform, kl; + char *h0, *h1, *tf1, *tf2; + char tname[12]; + char temp[16]; + char tform[16]; + int tverb; + int bintable = 0; + + h0 = header; + +/* Make sure this is really a FITS table file header */ + temp[0] = 0; + hgets (header,"XTENSION",16,temp); + if (strlen (temp) == 0) { + snprintf (fitserrmsg,79, "FITSRTHEAD: Not a FITS table header\n"); + return (-1); + } + else if (!strcmp (temp, "BINTABLE")) { + bintable = 1; + } + else if (strcmp (temp, "TABLE")) { + snprintf (fitserrmsg,79, "FITSRTHEAD: %s extension, not TABLE\n",temp); + return (-1); + } + +/* Get table size from FITS header */ + *nchar = 0; + hgeti4 (header,"NAXIS1",nchar); + *nrows = 0; + hgeti4 (header,"NAXIS2", nrows); + if (*nrows <= 0 || *nchar <= 0) { + snprintf (fitserrmsg,79, "FITSRTHEAD: cannot read %d x %d table\n", + *nrows,*nchar); + return (-1); + } + +/* Set up table for access to individual fields */ + nfields = 0; + hgeti4 (header,"TFIELDS",&nfields); + if (verbose) + fprintf (stderr, "FITSRTHEAD: %d fields per table entry\n", nfields); + if (nfields > bfields) { + if (bfields > 0) + free ((void *)pw); + pw = (struct Keyword *) calloc (nfields, sizeof(struct Keyword)); + if (pw == NULL) { + snprintf (fitserrmsg,79,"FITSRTHEAD: cannot allocate table structure\n"); + return (-1); + } + if (bfields > 0) + free ((void *)lpnam); + lpnam = (int *) calloc (nfields, sizeof(int)); + if (lpnam == NULL) { + snprintf (fitserrmsg,79,"FITSRTHEAD: cannot allocate length structure\n"); + return (-1); + } + bfields = nfields; + } + + tverb = verbose; + verbose = 0; + ikf = 0; + + for (ifield = 0; ifield < nfields; ifield++) { + + /* Name of field */ + for (i = 0; i < 12; i++) tname[i] = 0; + sprintf (tname, "TTYPE%d", ifield+1);; + temp[0] = 0; + h1 = ksearch (h0,tname); + h0 = h1; + hgets (h0,tname,16,temp); + strcpy (pw[ifield].kname,temp); + pw[ifield].lname = strlen (pw[ifield].kname); + + /* Sequence of field on line */ + pw[ifield].kn = ifield + 1; + + /* First column of field */ + if (bintable) + pw[ifield].kf = ikf; + else { + for (i = 0; i < 12; i++) tname[i] = 0; + sprintf (tname, "TBCOL%d", ifield+1); + pw[ifield].kf = 0; + hgeti4 (h0,tname, &pw[ifield].kf); + } + + /* Length of field */ + for (i = 0; i < 12; i++) tname[i] = 0; + sprintf (tname, "TFORM%d", ifield+1);; + tform[0] = 0; + hgets (h0,tname,16,tform); + strcpy (pw[ifield].kform, tform); + ltform = strlen (tform); + if (tform[ltform-1] == 'A') { + pw[ifield].kform[0] = 'A'; + for (i = 0; i < ltform-1; i++) + pw[ifield].kform[i+1] = tform[i]; + pw[ifield].kform[ltform] = (char) 0; + tf1 = pw[ifield].kform + 1; + kl = atof (tf1); + } + else if (!strcmp (tform,"I")) + kl = 2; + else if (!strcmp (tform, "J")) + kl = 4; + else if (!strcmp (tform, "E")) + kl = 4; + else if (!strcmp (tform, "D")) + kl = 8; + else { + tf1 = tform + 1; + tf2 = strchr (tform,'.'); + if (tf2 != NULL) + *tf2 = ' '; + kl = atoi (tf1); + } + pw[ifield].kl = kl; + ikf = ikf + kl; + } + +/* Set up table for access to desired fields */ + verbose = tverb; + if (verbose) + fprintf (stderr, "FITSRTHEAD: %d keywords read\n", *nk); + +/* If nk = 0, allocate and return structures for all table fields */ + if (*nk <= 0) { + *kw = pw; + *nk = nfields; + return (0); + } + else + rw = *kw; + +/* Find each desired keyword in the header */ + for (ik = 0; ik < *nk; ik++) { + if (rw[ik].kn <= 0) { + for (ifield = 0; ifield < nfields; ifield++) { + if (rw[ik].lname != pw[ifield].lname) + continue; + if (strcmp (pw[ifield].kname, rw[ik].kname) == 0) { + break; + } + } + } + else + ifield = rw[ik].kn - 1; + +/* Set pointer, lentth, and name in returned array of structures */ + rw[ik].kn = ifield + 1; + rw[ik].kf = pw[ifield].kf - 1; + rw[ik].kl = pw[ifield].kl; + strcpy (rw[ik].kform, pw[ifield].kform); + strcpy (rw[ik].kname, pw[ifield].kname); + } + + return (0); +} + + +int +fitsrtline (fd, nbhead, lbuff, tbuff, irow, nbline, line) + +int fd; /* File descriptor for FITS file */ +int nbhead; /* Number of bytes in FITS header */ +int lbuff; /* Number of bytes in table buffer */ +char *tbuff; /* FITS table buffer */ +int irow; /* Number of table row to read */ +int nbline; /* Number of bytes to read for this line */ +char *line; /* One line of FITS table (returned) */ + +{ + int nbuff, nlbuff; + int nbr = 0; + int offset, offend, ntry, ioff; + char *tbuff1; + + offset = nbhead + (nbline * irow); + offend = offset + nbline - 1; + +/* Read a new buffer of the FITS table into memory if needed */ + if (offset < offset1 || offend > offset2) { + nlbuff = lbuff / nbline; + nbuff = nlbuff * nbline; + for (ntry = 0; ntry < 3; ntry++) { + ioff = lseek (fd, offset, SEEK_SET); + if (ioff < offset) { + if (ntry == 2) + return (0); + else + continue; + } + nbr = read (fd, tbuff, nbuff); + if (nbr < nbline) { + if (verbose) + fprintf (stderr, "FITSRTLINE: %d / %d bytes read %d\n", + nbr,nbuff,ntry); + if (ntry == 2) + return (nbr); + } + else + break; + } + offset1 = offset; + offset2 = offset + nbr - 1; + strncpy (line, tbuff, nbline); + return (nbline); + } + else { + tbuff1 = tbuff + (offset - offset1); + strncpy (line, tbuff1, nbline); + return (nbline); + } +} + + +void +fitsrtlset () +{ + offset1 = 0; + offset2 = 0; + return; +} + + +/* FTGETI2 -- Extract n'th column from FITS table line as short */ + +short +ftgeti2 (entry, kw) + +char *entry; /* Row or entry from table */ +struct Keyword *kw; /* Table column information from FITS header */ +{ + char temp[30]; + short i; + int j; + float r; + double d; + + if (ftgetc (entry, kw, temp, 30)) { + if (!strcmp (kw->kform, "I")) + moveb (temp, (char *) &i, 2, 0, 0); + else if (!strcmp (kw->kform, "J")) { + moveb (temp, (char *) &j, 4, 0, 0); + i = (short) j; + } + else if (!strcmp (kw->kform, "E")) { + moveb (temp, (char *) &r, 4, 0, 0); + i = (short) r; + } + else if (!strcmp (kw->kform, "D")) { + moveb (temp, (char *) &d, 8, 0, 0); + i = (short) d; + } + else + i = (short) atof (temp); + return (i); + } + else + return ((short) 0); +} + + +/* FTGETI4 -- Extract n'th column from FITS table line as int */ + +int +ftgeti4 (entry, kw) + +char *entry; /* Row or entry from table */ +struct Keyword *kw; /* Table column information from FITS header */ +{ + char temp[30]; + short i; + int j; + float r; + double d; + + if (ftgetc (entry, kw, temp, 30)) { + if (!strcmp (kw->kform, "I")) { + moveb (temp, (char *) &i, 2, 0, 0); + j = (int) i; + } + else if (!strcmp (kw->kform, "J")) + moveb (temp, (char *) &j, 4, 0, 0); + else if (!strcmp (kw->kform, "E")) { + moveb (temp, (char *) &r, 4, 0, 0); + j = (int) r; + } + else if (!strcmp (kw->kform, "D")) { + moveb (temp, (char *) &d, 8, 0, 0); + j = (int) d; + } + else + j = (int) atof (temp); + return (j); + } + else + return (0); +} + + +/* FTGETR4 -- Extract n'th column from FITS table line as float */ + +float +ftgetr4 (entry, kw) + +char *entry; /* Row or entry from table */ +struct Keyword *kw; /* Table column information from FITS header */ +{ + char temp[30]; + short i; + int j; + float r; + double d; + + if (ftgetc (entry, kw, temp, 30)) { + if (!strcmp (kw->kform, "I")) { + moveb (temp, (char *) &i, 2, 0, 0); + r = (float) i; + } + else if (!strcmp (kw->kform, "J")) { + moveb (temp, (char *) &j, 4, 0, 0); + r = (float) j; + } + else if (!strcmp (kw->kform, "E")) + moveb (temp, (char *) &r, 4, 0, 0); + else if (!strcmp (kw->kform, "D")) { + moveb (temp, (char *) &d, 8, 0, 0); + r = (float) d; + } + else + r = (float) atof (temp); + return (r); + } + else + return ((float) 0.0); +} + + +/* FTGETR8 -- Extract n'th column from FITS table line as double */ + +double +ftgetr8 (entry, kw) + +char *entry; /* Row or entry from table */ +struct Keyword *kw; /* Table column information from FITS header */ +{ + char temp[30]; + short i; + int j; + float r; + double d; + + if (ftgetc (entry, kw, temp, 30)) { + if (!strcmp (kw->kform, "I")) { + moveb (temp, (char *) &i, 2, 0, 0); + d = (double) i; + } + else if (!strcmp (kw->kform, "J")) { + moveb (temp, (char *) &j, 4, 0, 0); + d = (double) j; + } + else if (!strcmp (kw->kform, "E")) { + moveb (temp, (char *) &r, 4, 0, 0); + d = (double) r; + } + else if (!strcmp (kw->kform, "D")) + moveb (temp, (char *) &d, 8, 0, 0); + else + d = atof (temp); + return (d); + } + else + return ((double) 0.0); +} + + +/* FTGETC -- Extract n'th column from FITS table line as character string */ + +int +ftgetc (entry, kw, string, maxchar) + +char *entry; /* Row or entry from table */ +struct Keyword *kw; /* Table column information from FITS header */ +char *string; /* Returned string */ +int maxchar; /* Maximum number of characters in returned string */ +{ + int length = maxchar; + + if (kw->kl < length) + length = kw->kl; + if (length > 0) { + strncpy (string, entry+kw->kf, length); + string[length] = 0; + return ( 1 ); + } + else + return ( 0 ); +} + +extern int errno; + + +/*FITSWIMAGE -- Write FITS header and image */ + +int +fitswimage (filename, header, image) + +char *filename; /* Name of FITS image file */ +char *header; /* FITS image header */ +char *image; /* FITS image pixels */ + +{ + int fd; + + /* Open the output file */ + if (strcasecmp (filename,"stdout") ) { + + if (!access (filename, 0)) { + fd = open (filename, O_WRONLY); + if (fd < 3) { + snprintf (fitserrmsg,79, "FITSWIMAGE: file %s not writeable\n", filename); + return (0); + } + } + else { + fd = open (filename, O_RDWR+O_CREAT, 0666); + if (fd < 3) { + snprintf (fitserrmsg,79, "FITSWIMAGE: cannot create file %s\n", filename); + return (0); + } + } + } +#ifndef VMS + else + fd = STDOUT_FILENO; +#endif + + return (fitswhdu (fd, filename, header, image)); +} + + +/*FITSWEXT -- Write FITS header and image as extension to a file */ + +int +fitswext (filename, header, image) + +char *filename; /* Name of IFTS image file */ +char *header; /* FITS image header */ +char *image; /* FITS image pixels */ + +{ + int fd; + + /* Open the output file */ + if (strcasecmp (filename,"stdout") ) { + + if (!access (filename, 0)) { + fd = open (filename, O_WRONLY); + if (fd < 3) { + snprintf (fitserrmsg,79, "FITSWEXT: file %s not writeable\n", + filename); + return (0); + } + } + else { + fd = open (filename, O_APPEND, 0666); + if (fd < 3) { + snprintf (fitserrmsg,79, "FITSWEXT: cannot append to file %s\n", + filename); + return (0); + } + } + } +#ifndef VMS + else + fd = STDOUT_FILENO; +#endif + + return (fitswhdu (fd, filename, header, image)); +} + + +/* FITSWHDU -- Write FITS head and image as extension */ + +int +fitswhdu (fd, filename, header, image) + +int fd; /* File descriptor */ +char *filename; /* Name of IFTS image file */ +char *header; /* FITS image header */ +char *image; /* FITS image pixels */ +{ + int nbhead, nbimage, nblocks, bytepix, i, nbhw; + int bitpix, naxis, iaxis, naxisi, nbytes, nbw, nbpad, nbwp, simple; + char *endhead, *padding; + double bzero, bscale; + char keyword[32]; + + /* Change BITPIX=-16 files to BITPIX=16 with BZERO and BSCALE */ + bitpix = 0; + hgeti4 (header,"BITPIX",&bitpix); + if (bitpix == -16) { + if (!hgetr8 (header, "BZERO", &bzero) && + !hgetr8 (header, "BSCALE", &bscale)) { + bitpix = 16; + hputi4 (header, "BITPIX", bitpix); + hputr8 (header, "BZERO", 32768.0); + hputr8 (header, "BSCALE", 1.0); + } + } + + /* Write header to file */ + endhead = ksearch (header,"END") + 80; + nbhead = endhead - header; + nbhw = write (fd, header, nbhead); + if (nbhw < nbhead) { + snprintf (fitserrmsg,79, "FITSWHDU: wrote %d / %d bytes of header to file %s\n", + nbhw, nbhead, filename); + (void)close (fd); + return (0); + } + + /* Write extra spaces to make an integral number of 2880-byte blocks */ + nblocks = nbhead / FITSBLOCK; + if (nblocks * FITSBLOCK < nbhead) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + nbpad = nbytes - nbhead; + padding = (char *)calloc (1, nbpad); + for (i = 0; i < nbpad; i++) + padding[i] = ' '; + nbwp = write (fd, padding, nbpad); + if (nbwp < nbpad) { + snprintf (fitserrmsg,79, "FITSWHDU: wrote %d / %d bytes of header padding to file %s\n", + nbwp, nbpad, filename); + (void)close (fd); + return (0); + } + nbhw = nbhw + nbwp; + free (padding); + + /* Return if file has no data */ + if (bitpix == 0 || image == NULL) { + /* snprintf (fitserrmsg,79, "FITSWHDU: BITPIX is 0; image not written\n"); */ + (void)close (fd); + return (0); + } + + /* If SIMPLE=F in header, just write whatever is in the buffer */ + hgetl (header, "SIMPLE", &simple); + if (!simple) { + hgeti4 (header, "NBDATA", &nbytes); + nbimage = nbytes; + } + + else { + + /* Compute size of pixel in bytes */ + bytepix = bitpix / 8; + if (bytepix < 0) bytepix = -bytepix; + nbimage = bytepix; + + /* Compute size of image in bytes using relevant header parameters */ + naxis = 1; + hgeti4 (header,"NAXIS",&naxis); + for (iaxis = 1; iaxis <= naxis; iaxis++) { + sprintf (keyword, "NAXIS%d", iaxis); + naxisi = 1; + hgeti4 (header,keyword,&naxisi); + nbimage = nbimage * naxisi; + } + + /* Number of bytes to write is an integral number of FITS blocks */ + nblocks = nbimage / FITSBLOCK; + if (nblocks * FITSBLOCK < nbimage) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Byte-reverse image before writing, if necessary */ + if (imswapped ()) + imswap (bitpix, image, nbimage); + } + + /* Write image to file */ + nbw = write (fd, image, nbimage); + if (nbw < nbimage) { + snprintf (fitserrmsg,79, "FITSWHDU: wrote %d / %d bytes of image to file %s\n", + nbw, nbimage, filename); + return (0); + } + + /* Write extra zeroes to make an integral number of 2880-byte blocks */ + nbpad = nbytes - nbimage; + if (nbpad > 0) { + padding = (char *)calloc (1, nbpad); + nbwp = write (fd, padding, nbpad); + if (nbwp < nbpad) { + snprintf (fitserrmsg,79, "FITSWHDU: wrote %d / %d bytes of image padding to file %s\n", + nbwp, nbpad, filename); + (void)close (fd); + return (0); + } + free (padding); + } + else + nbwp = 0; + + (void)close (fd); + + /* Byte-reverse image after writing, if necessary */ + if (imswapped ()) + imswap (bitpix, image, nbimage); + + nbw = nbw + nbwp + nbhw; + return (nbw); +} + + +/*FITSCIMAGE -- Write FITS header and copy FITS image + Return number of bytes in output image, 0 if failure */ + +int +fitscimage (filename, header, filename0) + +char *filename; /* Name of output FITS image file */ +char *header; /* FITS image header */ +char *filename0; /* Name of input FITS image file */ + +{ + int fdout, fdin; + int nbhead, nbimage, nblocks, bytepix; + int bitpix, naxis, naxis1, naxis2, nbytes, nbw, nbpad, nbwp; + char *endhead, *lasthead, *padding; + char *image; /* FITS image pixels */ + char *oldhead; /* Input file image header */ + int nbhead0; /* Length of input file image header */ + int lhead0; + int nbbuff, nbuff, ibuff, nbr, nbdata; + + /* Compute size of image in bytes using relevant header parameters */ + naxis = 1; + hgeti4 (header, "NAXIS", &naxis); + naxis1 = 1; + hgeti4 (header, "NAXIS1", &naxis1); + naxis2 = 1; + hgeti4 (header, "NAXIS2", &naxis2); + hgeti4 (header, "BITPIX", &bitpix); + bytepix = bitpix / 8; + if (bytepix < 0) bytepix = -bytepix; + + /* If either dimension is one and image is 3-D, read all three dimensions */ + if (naxis == 3 && (naxis1 ==1 || naxis2 == 1)) { + int naxis3; + hgeti4 (header,"NAXIS3",&naxis3); + nbimage = naxis1 * naxis2 * naxis3 * bytepix; + } + else + nbimage = naxis1 * naxis2 * bytepix; + + nblocks = nbimage / FITSBLOCK; + if (nblocks * FITSBLOCK < nbimage) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Allocate image buffer */ + nbbuff = FITSBLOCK * 100; + if (nbytes < nbbuff) + nbbuff = nbytes; + image = (char *) calloc (1, nbbuff); + nbuff = nbytes / nbbuff; + if (nbytes > nbuff * nbbuff) + nbuff = nbuff + 1; + + /* Read input file header */ + if ((oldhead = fitsrhead (filename0, &lhead0, &nbhead0)) == NULL) { + snprintf (fitserrmsg, 79,"FITSCIMAGE: header of input file %s cannot be read\n", + filename0); + return (0); + } + + /* Find size of output header */ + nbhead = fitsheadsize (header); + + /* If overwriting, be more careful if new header is longer than old */ + if (!strcmp (filename, filename0) && nbhead > nbhead0) { + if ((image = fitsrimage (filename0, nbhead0, oldhead)) == NULL) { + snprintf (fitserrmsg,79, "FITSCIMAGE: cannot read image from file %s\n", + filename0); + free (oldhead); + return (0); + } + return (fitswimage (filename, header, image)); + } + free (oldhead); + + /* Open the input file and skip over the header */ + if (strcasecmp (filename0,"stdin")) { + fdin = -1; + fdin = fitsropen (filename0); + if (fdin < 0) { + snprintf (fitserrmsg, 79,"FITSCIMAGE: cannot read file %s\n", filename0); + return (0); + } + + /* Skip over FITS header */ + if (lseek (fdin, nbhead0, SEEK_SET) < 0) { + (void)close (fdin); + snprintf (fitserrmsg,79, "FITSCIMAGE: cannot skip header of file %s\n", + filename0); + return (0); + } + } +#ifndef VMS + else + fdin = STDIN_FILENO; +#endif + + /* Open the output file */ + if (!access (filename, 0)) { + fdout = open (filename, O_WRONLY); + if (fdout < 3) { + snprintf (fitserrmsg,79, "FITSCIMAGE: file %s not writeable\n", filename); + return (0); + } + } + else { + fdout = open (filename, O_RDWR+O_CREAT, 0666); + if (fdout < 3) { + snprintf (fitserrmsg,79, "FITSCHEAD: cannot create file %s\n", filename); + return (0); + } + } + + /* Pad header with spaces */ + endhead = ksearch (header,"END") + 80; + lasthead = header + nbhead; + while (endhead < lasthead) + *(endhead++) = ' '; + + /* Write header to file */ + nbw = write (fdout, header, nbhead); + if (nbw < nbhead) { + snprintf (fitserrmsg, 79,"FITSCIMAGE: wrote %d / %d bytes of header to file %s\n", + nbw, nbytes, filename); + (void)close (fdout); + (void)close (fdin); + return (0); + } + + /* Return if no data */ + if (bitpix == 0) { + (void)close (fdout); + (void)close (fdin); + return (nbhead); + } + + nbdata = 0; + for (ibuff = 0; ibuff < nbuff; ibuff++) { + nbr = read (fdin, image, nbbuff); + if (nbr > 0) { + nbw = write (fdout, image, nbr); + nbdata = nbdata + nbw; + } + } + + /* Write extra to make integral number of 2880-byte blocks */ + nblocks = nbdata / FITSBLOCK; + if (nblocks * FITSBLOCK < nbdata) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + nbpad = nbytes - nbdata; + padding = (char *)calloc (1,nbpad); + nbwp = write (fdout, padding, nbpad); + nbw = nbdata + nbwp; + free (padding); + + (void)close (fdout); + (void)close (fdin); + + if (nbw < nbimage) { + snprintf (fitserrmsg, 79, "FITSWIMAGE: wrote %d / %d bytes of image to file %s\n", + nbw, nbimage, filename); + return (0); + } + else + return (nbw); +} + + +/* FITSWHEAD -- Write FITS header and keep file open for further writing */ + +int +fitswhead (filename, header) + +char *filename; /* Name of IFTS image file */ +char *header; /* FITS image header */ + +{ + int fd; + int nbhead, nblocks; + int nbytes, nbw; + char *endhead, *lasthead; + + /* Open the output file */ + if (!access (filename, 0)) { + fd = open (filename, O_WRONLY); + if (fd < 3) { + snprintf (fitserrmsg, 79, "FITSWHEAD: file %s not writeable\n", filename); + return (0); + } + } + else { + fd = open (filename, O_RDWR+O_CREAT, 0666); + if (fd < 3) { + snprintf (fitserrmsg, 79, "FITSWHEAD: cannot create file %s\n", filename); + return (0); + } + } + + /* Write header to file */ + endhead = ksearch (header,"END") + 80; + nbhead = endhead - header; + nblocks = nbhead / FITSBLOCK; + if (nblocks * FITSBLOCK < nbhead) + nblocks = nblocks + 1; + nbytes = nblocks * FITSBLOCK; + + /* Pad header with spaces */ + lasthead = header + nbytes; + while (endhead < lasthead) + *(endhead++) = ' '; + + nbw = write (fd, header, nbytes); + if (nbw < nbytes) { + fprintf (stderr, "FITSWHEAD: wrote %d / %d bytes of header to file %s\n", + nbw, nbytes, filename); + (void)close (fd); + return (0); + } + return (fd); +} + + +/* FITSWEXHEAD -- Write FITS header in place */ + +int +fitswexhead (filename, header) + +char *filename; /* Name of FITS image file with ,extension */ +char *header; /* FITS image header */ + +{ + int fd; + int nbhead, lhead; + int nbw, nbnew, nbold; + char *endhead, *lasthead, *oldheader; + char *ext, cext; + + /* Compare size of existing header to size of new header */ + fitsinherit = 0; + oldheader = fitsrhead (filename, &lhead, &nbhead); + if (oldheader == NULL) { + snprintf (fitserrmsg, 79, "FITSWEXHEAD: file %s cannot be read\n", filename); + return (-1); + } + nbold = fitsheadsize (oldheader); + nbnew = fitsheadsize (header); + + /* Return if the new header is bigger than the old header */ + if (nbnew > nbold) { + snprintf (fitserrmsg, 79, "FITSWEXHEAD: old header %d bytes, new header %d bytes\n", nbold,nbnew); + free (oldheader); + oldheader = NULL; + return (-1); + } + + /* Add blank lines if new header is smaller than the old header */ + else if (nbnew < nbold) { + strcpy (oldheader, header); + endhead = ksearch (oldheader,"END"); + lasthead = oldheader + nbold; + while (endhead < lasthead) + *(endhead++) = ' '; + strncpy (lasthead-80, "END", 3); + } + + /* Pad header with spaces */ + else { + endhead = ksearch (header,"END") + 80; + lasthead = header + nbnew; + while (endhead < lasthead) + *(endhead++) = ' '; + strncpy (oldheader, header, nbnew); + } + + /* Check for FITS extension and ignore for file opening */ + ext = strchr (filename, ','); + if (ext == NULL) + ext = strchr (filename, '['); + if (ext != NULL) { + cext = *ext; + *ext = (char) 0; + } + + /* Open the output file */ + fd = open (filename, O_WRONLY); + if (ext != NULL) + *ext = cext; + if (fd < 3) { + snprintf (fitserrmsg, 79, "FITSWEXHEAD: file %s not writeable\n", filename); + return (-1); + } + + /* Skip to appropriate place in file */ + (void) lseek (fd, ibhead, SEEK_SET); + + /* Write header to file */ + nbw = write (fd, oldheader, nbold); + (void)close (fd); + free (oldheader); + oldheader = NULL; + if (nbw < nbold) { + fprintf (stderr, "FITSWHEAD: wrote %d / %d bytes of header to file %s\n", + nbw, nbold, filename); + return (-1); + } + return (0); +} + + +/* ISFITS -- Return 1 if FITS file, else 0 */ +int +isfits (filename) + +char *filename; /* Name of file for which to find size */ +{ + int diskfile; + char keyword[16]; + char *comma; + int nbr; + + /* First check to see if this is an assignment */ + if (strchr (filename, '=')) + return (0); + + /* Check for stdin (input from pipe) */ + else if (!strcasecmp (filename,"stdin")) + return (1); + + /* Then check file extension + else if (strsrch (filename, ".fit") || + strsrch (filename, ".fits") || + strsrch (filename, ".fts")) + return (1); */ + + /* If no FITS file extension, try opening the file */ + else { + if ((comma = strchr (filename,','))) + *comma = (char) 0; + if ((diskfile = open (filename, O_RDONLY)) < 0) { + if (comma) + *comma = ','; + return (0); + } + else { + nbr = read (diskfile, keyword, 8); + if (comma) + *comma = ','; + close (diskfile); + if (nbr < 8) + return (0); + else if (!strncmp (keyword, "SIMPLE", 6)) + return (1); + else + return (0); + } + } +} + + +/* FITSHEADSIZE -- Find size of FITS header */ + +int +fitsheadsize (header) + +char *header; /* FITS header */ +{ + char *endhead; + int nbhead, nblocks; + + endhead = ksearch (header,"END") + 80; + nbhead = endhead - header; + nblocks = nbhead / FITSBLOCK; + if (nblocks * FITSBLOCK < nbhead) + nblocks = nblocks + 1; + return (nblocks * FITSBLOCK); +} + + +/* Print error message */ +void +fitserr () +{ fprintf (stderr, "%s\n",fitserrmsg); + return; } + + +/* MOVEB -- Copy nbytes bytes from source+offs to dest+offd (any data type) */ + +void +moveb (source, dest, nbytes, offs, offd) + +char *source; /* Pointer to source */ +char *dest; /* Pointer to destination */ +int nbytes; /* Number of bytes to move */ +int offs; /* Offset in bytes in source from which to start copying */ +int offd; /* Offset in bytes in destination to which to start copying */ +{ +char *from, *last, *to; + from = source + offs; + to = dest + offd; + last = from + nbytes; + while (from < last) *(to++) = *(from++); + return; +} + +/* + * Feb 8 1996 New subroutines + * Apr 10 1996 Add subroutine list at start of file + * Apr 17 1996 Print error message to stderr + * May 2 1996 Write using stream IO + * May 14 1996 If FITSRTOPEN NK is zero, return all keywords in header + * May 17 1996 Make header internal to FITSRTOPEN + * Jun 3 1996 Use stream I/O for input as well as output + * Jun 10 1996 Remove unused variables after running lint + * Jun 12 1996 Deal with byte-swapped images + * Jul 11 1996 Rewrite code to separate header and data reading + * Aug 6 1996 Fixed small defects after lint + * Aug 6 1996 Drop unused NBHEAD argument from FITSRTHEAD + * Aug 13 1996 If filename is stdin, read from standard input instead of file + * Aug 30 1996 Use write for output, not fwrite + * Sep 4 1996 Fix mode when file is created + * Oct 15 1996 Drop column argument from FGET* subroutines + * Oct 15 1996 Drop unused variable + * Dec 17 1996 Add option to skip bytes in file before reading the header + * Dec 27 1996 Turn nonprinting header characters into spaces + * + * Oct 9 1997 Add FITS extension support as filename,extension + * Dec 15 1997 Fix minor bugs after lint + * + * Feb 23 1998 Do not append primary header if getting header for ext. 0 + * Feb 23 1998 Accept either bracketed or comma extension + * Feb 24 1998 Add SIMPLE keyword to start of extracted extension + * Apr 30 1998 Fix error return if not table file after Allan Brighton + * May 4 1998 Fix error in argument sequence in HGETS call + * May 27 1998 Include fitsio.h and imio.h + * Jun 1 1998 Add VMS fixes from Harry Payne at STScI + * Jun 3 1998 Fix bug reading EXTNAME + * Jun 11 1998 Initialize all header parameters before reading them + * Jul 13 1998 Clarify argument definitions + * Aug 6 1998 Rename fitsio.c to fitsfile.c to avoid conflict with CFITSIO + * Aug 13 1998 Add FITSWHEAD to write only header + * Sep 25 1998 Allow STDIN or stdin for standard input reading + * Oct 5 1998 Add isfits() to decide whether a file is FITS + * Oct 9 1998 Assume stdin and STDIN to be FITS files in isfits() + * Nov 30 1998 Fix bug found by Andreas Wicenec when reading large headers + * Dec 8 1998 Fix bug introduced by previous bug fix + * + * Jan 4 1999 Do not print error message if BITPIX is 0 + * Jan 27 1999 Read and write all of 3D images if one dimension is 1 + * Jan 27 1999 Pad out data to integral number of 2880-byte blocks + * Apr 29 1999 Write BITPIX=-16 files as BITPIX=16 with BSCALE and BZERO + * Apr 30 1999 Add % as alternative to , to denote sub-images + * May 25 1999 Set buffer offsets to 0 when FITS table file is opened + * Jul 14 1999 Do not try to write image data if BITPIX is 0 + * Sep 27 1999 Add STDOUT as output filename option in fitswimage() + * Oct 6 1999 Set header length global variable hget.lhead0 in fitsrhead() + * Oct 14 1999 Update header length as it is changed in fitsrhead() + * Oct 20 1999 Change | in if statements to || + * Oct 25 1999 Change most malloc() calls to calloc() + * Nov 24 1999 Add fitscimage() + * + * Feb 23 2000 Fix problem with some error returns in fitscimage() + * Mar 17 2000 Drop unused variables after lint + * Jul 20 2000 Drop BITPIX and NAXIS from primary header if extension printerd + * Jul 20 2000 Start primary part of header with ROOTHEAD keyword + * Jul 28 2000 Add loop to deal with buffered stdin + * + * Jan 11 2001 Print all messages to stderr + * Jan 12 2001 Add extension back onto filename after fitsropen() (Guy Rixon) + * Jan 18 2001 Drop EXTEND keyword when extracting an extension + * Jan 18 2001 Add fitswext() to append HDU and fitswhdu() to do actual writing + * Jan 22 2001 Ignore WCS name or letter following a : in file name in fitsrhead() + * Jan 30 2001 Fix FITSCIMAGE so it doesn't overwrite data when overwriting a file + * Feb 20 2001 Ignore WCS name or letter following a : in file name in fitsropen() + * Feb 23 2001 Initialize rbrac in fitsropen() + * Mar 8 2001 Use % instead of : for WCS specification in file name + * Mar 9 2001 Fix bug so primary header is always appended to secondary header + * Mar 9 2001 Change NEXTEND to NUMEXT in appended primary header + * Mar 20 2001 Declare fitsheadsize() in fitschead() + * Apr 24 2001 When matching column names, use longest length + * Jun 27 2001 In fitsrthead(), allocate pw and lpnam only if more space needed + * Aug 24 2001 In isfits(), return 0 if argument contains an equal sign + * + * Jan 28 2002 In fitsrhead(), allow stdin to include extension and/or WCS selection + * Jun 18 2002 Save error messages as fitserrmsg and use fitserr() to print them + * Oct 21 2002 Add fitsrsect() to read a section of an image + * + * Feb 4 2003 Open catalog file rb instead of r (Martin Ploner, Bern) + * Apr 2 2003 Drop unused variable in fitsrsect() + * Jul 11 2003 Use strcasecmp() to check for stdout and stdin + * Aug 1 2003 If no other header, return root header from fitsrhead() + * Aug 20 2003 Add fitsrfull() to read n-dimensional FITS images + * Aug 21 2003 Modify fitswimage() to always write n-dimensional FITS images + * Nov 18 2003 Fix minor bug in fitswhdu() + * Dec 3 2003 Remove unused variable lasthead in fitswhdu() + * + * May 3 2004 Do not always append primary header to extension header + * May 3 2004 Add ibhead as position of header read in file + * May 19 2004 Do not reset ext if NULL in fitswexhead() + * Jul 1 2004 Initialize INHERIT to 1 + * Aug 30 2004 Move fitsheadsize() declaration to fitsfile.h + * Aug 31 2004 If SIMPLE=F, put whatever is in file after header in image + * + * Mar 17 2005 Use unbuffered I/O in isfits() for robustness + * Jun 27 2005 Drop unused variable nblocks in fitswexhead() + * Aug 8 2005 Fix space-padding bug in fitswexhead() found by Armin Rest + * Sep 30 2005 Fix fitsrsect() to position relatively, not absolutely + * Oct 28 2005 Add error message if desired FITS extension is not found + * Oct 28 2005 Fix initialization problem found by Sergey Koposov + * + * Feb 23 2006 Add fitsrtail() to read appended FITS headers + * Feb 27 2006 Add file name to header-reading error messages + * May 3 2006 Remove declarations of unused variables + * Jun 20 2006 Initialize uninitialized variables + * Nov 2 2006 Change all realloc() calls to calloc() + * + * Jan 5 2007 In fitsrtail(), change control characters in header to spaces + * Apr 30 2007 Improve error reporting in FITSRFULL + * Nov 28 2007 Add support to BINTABLE in ftget*() and fitsrthead() + * Dec 20 2007 Add data heap numerated by PCOUNT when skipping HDU in fitsrhead() + * Dec 20 2007 Return NULL pointer if fitsrhead() cannot find requested HDU + * + * Apr 7 2008 Drop comma from name when reading file in isfits() + * Jun 27 2008 Do not append primary data header if it is the only header + * Nov 21 2008 In fitswhead(), print message if too few bytes written + * + * Sep 18 2009 In fitswexhead() write to error string instead of stderr + * Sep 22 2009 In fitsrthead(), fix lengths for ASCII numeric table entries + * Sep 25 2009 Add subroutine moveb() and fix calls to it + * Sep 25 2009 Fix several small errors found by Jessicalas Burke + * + * Mar 29 2010 In fitswhead(), always pad blocks to 2880 bytes with spaces + * Mar 31 2010 In fitsrhead(), fix bug reading long primary headers + * + * Sep 15 2011 In fitsrsect() declare impos and nblin off_t + * Sep 15 2011 In fitsrtail() declare offset off_t + * Sep 15 2011 Declare global variable ibhead off_t + * + * Jul 25 2014 Fix bug when reallocating buffer for long headers + */ diff --git a/tksao/wcssubs/fitsfile.h b/tksao/wcssubs/fitsfile.h new file mode 100644 index 0000000..cd67f37 --- /dev/null +++ b/tksao/wcssubs/fitsfile.h @@ -0,0 +1,1293 @@ +/*** File fitsfile.h FITS and IRAF file access subroutines + *** June 20, 2014 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2014 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +#ifndef fitsfile_h_ +#define fitsfile_h_ +#include "fitshead.h" + +/* Declarations for subroutines in fitsfile.c, imhfile.c, imio.c, + * fileutil.c, and dateutil.c */ + +#define FITSBLOCK 2880 + +/* FITS table keyword structure */ +struct Keyword { + char kname[10]; /* Keyword for table entry */ + int lname; /* Length of keyword name */ + int kn; /* Index of entry on line */ + int kf; /* Index in line of first character of entry */ + int kl; /* Length of entry value */ + char kform[8]; /* Format for this value */ +}; + +/* Structure for access to tokens within a string */ +#define MAXTOKENS 1000 /* Maximum number of tokens to parse */ +#define MAXWHITE 20 /* Maximum number of different whitespace characters */ +struct Tokens { + char *line; /* Line which has been parsed */ + int lline; /* Number of characters in line */ + int ntok; /* Number of tokens on line */ + int nwhite; /* Number of whitespace characters */ + char white[MAXWHITE]; /* Whitespace (separator) characters */ + char *tok1[MAXTOKENS]; /* Pointers to start of tokens */ + int ltok[MAXTOKENS]; /* Lengths of tokens */ + int itok; /* Current token number */ +}; + +#ifdef __cplusplus /* C++ prototypes */ +extern "C" { +#endif + + +#ifdef __STDC__ /* Full ANSI prototypes */ + +/* Declarations for subroutines in fitsfile.c, imhfile.c, imio.c, + * fileutil.c, and dateutil.c */ + +/* FITS file access subroutines in fitsfile.c */ + int fitsropen( /* Open a FITS file for reading, returning a FILE pointer */ + char *inpath); /* Pathname for FITS tables file to read */ + char *fitsrhead( /* Read a FITS header */ + char *filename, /* Name of FITS image file */ + int *lhead, /* Allocated length of FITS header in bytes (returned) */ + int *nbhead); /* Number of bytes before start of data (returned) */ + char *fitsrtail( /* Read FITS header appended to graphics file */ + char *filename, /* Name of FITS image file */ + int *lhead, /* Allocated length of FITS header in bytes (returned) */ + int *nbhead); /* Number of bytes before start of data (returned) */ + char *fitsrimage( /* Read a FITS image */ + char *filename, /* Name of FITS image file */ + int nbhead, /* Actual length of image header(s) in bytes */ + char *header); /* FITS header for image (previously read) */ + char *fitsrfull( /* Read a FITS image of any dimension */ + char *filename, /* Name of FITS image file */ + int nbhead, /* Actual length of image header(s) in bytes */ + char *header); /* FITS header for image (previously read) */ + char *fitsrsect( /* Read a piece of a FITS image, header */ + char *filename, /* Name of FITS image file */ + char *header, /* FITS header for image (previously read) */ + int nbhead, /* Actual length of image header(s) in bytes */ + int x0, /* FITS image X coordinate of first pixel */ + int y0, /* FITS image Y coordinate of first pixel */ + int nx, /* Number of columns to read (less than NAXIS1) */ + int ny, /* Number of rows to read (less than NAXIS2) */ + int nlog); /* Note progress mod this rows */ + int fitswhead( /* Write FITS header; keep file open for further writing */ + char *filename, /* Name of FITS image file */ + char *header); /* FITS header for image (previously read) */ + int fitswexhead( /* Write FITS header in place */ + char *filename, /* Name of FITS image file */ + char *header); /* FITS header for image */ + int fitswext( /* Write FITS header and image as extension to a file */ + char *filename, /* Name of FITS image file */ + char *header, /* FITS image header */ + char *image); /* FITS image pixels */ + int fitswhdu( /* Write FITS head and image as extension */ + int fd, /* File descriptor */ + char *filename, /* Name of FITS image file */ + char *header, /* FITS image header */ + char *image); /* FITS image pixels */ + int fitswimage( /* Write FITS header and image */ + char *filename, /* Name of FITS image file */ + char *header, /* FITS image header */ + char *image); /* FITS image pixels */ + int fitscimage( /* Write FITS header and copy FITS image */ + char *filename, /* Name of output FITS image file */ + char *header, /* FITS image header */ + char *filename0); /* Name of input FITS image file */ + int isfits( /* Return 1 if file is a FITS file */ + char *filename); /* Name of file to check */ + void fitserr(); /* Print FITS error message to stderr */ + void setfitsinherit( /* Set flag to append primary data header */ + int inh); /* 1 to inherit primary data header, else 0 */ + int fitsheadsize( /* Return size of fitsheader in bytes */ + char *header); /* FITS image header */ + +/* FITS table file access subroutines in fitsfile.c */ + + int fitsrtopen( /* Open FITS table file and fill structure with + * pointers to selected keywords + * Return file descriptor (-1 if unsuccessful) */ + char *inpath, /* Pathname for FITS tables file to read */ + int *nk, /* Number of keywords to use */ + struct Keyword **kw, /* Structure for desired entries */ + int *nrows, /* Number of rows in table (returned) */ + int *nchar, /* Number of characters in one table row (returned) */ + int *nbhead); /* Number of characters before table starts */ + int fitsrthead( /* Read pointers to selected keywords + * from FITS table header */ + char *header, /* Header for FITS tables file */ + int *nk, /* Number of keywords to use */ + struct Keyword **kw, /* Structure for desired entries */ + int *nrows, /* Number of rows in table (returned) */ + int *nchar); /* Number of characters in one table row (returned) */ + void fitsrtlset(void); /* Reset FITS Table buffer limits from start of data */ + int fitsrtline( /* Return specified line of FITS table */ + int fd, /* File descriptor for FITS file */ + int nbhead, /* Number of bytes in FITS header */ + int lbuff, /* Number of bytes in table buffer */ + char *tbuff, /* FITS table buffer */ + int irow, /* Number of table row to read */ + int nbline, /* Number of bytes to read for this line */ + char *line); /* One line of FITS table (returned) */ +short ftgeti2( /* Extract column for keyword from FITS table line + * as short */ + char *entry, /* Row or entry from table */ + struct Keyword *kw); /* Table column information from FITS header */ + int ftgeti4( /* Extract column for keyword from FITS table line + * as int */ + char *entry, /* Row or entry from table */ + struct Keyword *kw); /* Table column information from FITS header */ +float ftgetr4( /* Extract column for keyword from FITS table line + * as float */ + char *entry, /* Row or entry from table */ + struct Keyword *kw); /* Table column information from FITS header */ + double ftgetr8( /* Extract column for keyword from FITS table line + * as double */ + char *entry, /* Row or entry from table */ + struct Keyword *kw); /* Table column information from FITS header */ + int ftgetc( /* Extract column for keyword from FITS table line + * as char string */ + char *entry, /* Row or entry from table */ + struct Keyword *kw, /* Table column information from FITS header */ + char *string, /* Returned string */ + int maxchar); /* Maximum number of characters in returned string */ + + void moveb ( /* Copy nbytes bytes from source+offs to dest+offd */ + char *source, /* Pointer to source */ + char *dest, /* Pointer to destination */ + int nbytes, /* Number of bytes to move */ + int offs, /* Offset in bytes in source from which to start copying */ + int offd); /* Offset in bytes in destination to which to start copying */ + + +/* IRAF file access subroutines in imhfile.c */ + + char *irafrhead( /* Read IRAF .imh header file and translate to FITS header */ + char *filename, /* Name of IRAF header file */ + int *lihead); /* Length of IRAF image header in bytes (returned) */ + char *irafrimage( /* Read IRAF image pixels (call after irafrhead) */ + char *fitsheader); /* FITS image header (filled) */ + int irafwhead( /* Write IRAF .imh header file */ + char *hdrname, /* Name of IRAF header file */ + int lhead, /* Length of IRAF header */ + char *irafheader, /* IRAF header */ + char *fitsheader); /* FITS image header */ + int irafwimage( /* Write IRAF .imh header file and .pix image file */ + char *hdrname, /* Name of IRAF header file */ + int lhead, /* Length of IRAF header */ + char *irafheader, /* IRAF header */ + char *fitsheader, /* FITS image header */ + char *image); /* IRAF image */ + int isiraf( /* return 1 if IRAF imh file, else 0 */ + char *filename); /* Name of file to check */ + char *iraf2fits( /* Convert IRAF image header to FITS image header, + * returning FITS header */ + char *hdrname, /* IRAF header file name (may be path) */ + char *irafheader, /* IRAF image header */ + int nbiraf, /* Number of bytes in IRAF header */ + int *nbfits); /* Number of bytes in FITS header (returned) */ + + char *fits2iraf( /* Convert FITS image header to IRAF image header, + * returning IRAF header */ + char *fitsheader, /* FITS image header */ + char *irafheader, /* IRAF image header (returned updated) */ + int nbhead, /* Length of IRAF header */ + int *nbiraf); /* Length of returned IRAF header */ + +/* Image pixel access subroutines in imio.c */ + + double getpix( /* Read one pixel from any data type 2-D array (0,0)*/ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel + * 16 = short, -16 = unsigned short, 32 = int + * -32 = float, -64 = double */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* Zero-based horizontal pixel number */ + int y); /* Zero-based vertical pixel number */ + double getpix1( /* Read one pixel from any data type 2-D array (1,1)*/ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* One-based horizontal pixel number */ + int y); /* One-based vertical pixel number */ + double maxvec( /* Get maximum value in vector from a image */ + char *image, /* Image array from which to extract vector */ + int bitpix, /* Number of bits per pixel in image */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to extract */ + int npix); /* Number of pixels to extract */ + double minvec( /* Get minimum value in vector from a image */ + char *image, /* Image array from which to extract vector */ + int bitpix, /* Number of bits per pixel in image */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to extract */ + int npix); /* Number of pixels to extract */ + void putpix( /* Write one pixel to any data type 2-D array (0,0)*/ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* Zero-based horizontal pixel number */ + int y, /* Zero-based vertical pixel number */ + double dpix); /* Value to put into image pixel */ + void putpix1( /* Write one pixel to any data type 2-D array (1,1) */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* One-based horizontal pixel number */ + int y, /* One-based vertical pixel number */ + double dpix); /* Value to put into image pixel */ + void addpix( /* Add to one pixel in any data type 2-D array (0,0)*/ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* Zero-based horizontal pixel number */ + int y, /* Zero-based vertical pixel number */ + double dpix); /* Value to add to image pixel */ + void addpix1( /* Add to one pixel in any data type 2-D array (1,1)*/ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + int w, /* Image width in pixels */ + int h, /* Image height in pixels */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int x, /* One-based horizontal pixel number */ + int y, /* One-based vertical pixel number */ + double dpix); /* Value to add to image pixel */ + void movepix( /* Move one pixel value between two 2-D arrays (0,0) */ + char *image1, /* Pointer to first pixel in input image */ + int bitpix1, /* Bits per input pixel (FITS codes) */ + int w1, /* Number of horizontal pixels in input image */ + int x1, /* Zero-based row for input pixel */ + int y1, /* Zero-based column for input pixel */ + char *image2, /* Pointer to first pixel in output image */ + int bitpix2, /* Bits per output pixel (FITS codes) */ + int w2, /* Number of horizontal pixels in output image */ + int x2, /* Zero-based row for output pixel */ + int y2); /* Zero-based column for output pixel */ + void movepix1( /* Move one pixel value between two 2-D arrays (1,1) */ + char *image1, /* Pointer to first pixel in input image */ + int bitpix1, /* Bits per input pixel (FITS codes) */ + int w1, /* Number of horizontal pixels in input image */ + int x1, /* One-based row for input pixel */ + int y1, /* One-based column for input pixel */ + char *image2, /* Pointer to first pixel in output image */ + int bitpix2, /* Bits per output pixel (FITS codes) */ + int w2, /* Number of horizontal pixels in output image */ + int x2, /* One-based row for output pixel */ + int y2); /* One-based column for output pixel */ + +/* Image vector processing subroutines in imio.c */ + + void addvec( /* Add constant to vector from 2-D array */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to which to add */ + int npix, /* Number of pixels to which to add */ + double dpix); /* Value to add to pixels */ + void multvec( /* Multiply vector from 2-D array by a constant */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to multiply */ + int npix, /* Number of pixels to multiply */ + double dpix); /* Value to add to pixels */ + void getvec( /* Read vector from 2-D array */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to extract */ + int npix, /* Number of pixels to extract */ + double *dvec0); /* Vector of pixels (returned) */ + void putvec( /* Write vector into 2-D array */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Offset of first pixel to insert */ + int npix, /* Number of pixels to insert */ + double *dvec0); /* Vector of pixels to insert */ + void fillvec( /* Write constant into a vector */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* Zero-based offset of first pixel to multiply */ + int npix, /* Number of pixels to multiply */ + double dpix); /* Value to which to set pixels */ + void fillvec1( /* Write constant into a vector */ + char *image, /* Image array as 1-D vector */ + int bitpix, /* FITS bits per pixel */ + double bzero, /* Zero point for pixel scaling */ + double bscale, /* Scale factor for pixel scaling */ + int pix1, /* One-based offset of first pixel to multiply */ + int npix, /* Number of pixels to multiply */ + double dpix); /* Value to which to set pixels */ + +/* Image pixel byte-swapping subroutines in imio.c */ + + void imswap( /* Swap alternating bytes in a vector */ + int bitpix, /* Number of bits per pixel */ + char *string, /* Address of starting point of bytes to swap */ + int nbytes); /* Number of bytes to swap */ + void imswap2( /* Swap bytes in a vector of 2-byte (short) integers */ + char *string, /* Address of starting point of bytes to swap */ + int nbytes); /* Number of bytes to swap */ + void imswap4( /* Reverse bytes in a vector of 4-byte numbers */ + char *string, /* Address of starting point of bytes to swap */ + int nbytes); /* Number of bytes to swap */ + void imswap8( /* Reverse bytes in a vector of 8-byte numbers */ + char *string, /* Address of starting point of bytes to swap */ + int nbytes); /* Number of bytes to swap */ + int imswapped(void); /* Return 1 if machine byte order is not FITS order */ + +/* File utilities from fileutil.c */ + + int getfilelines( /* Return number of lines in an ASCII file */ + char *filename); /* Name of file to check */ + char *getfilebuff( /* Return entire file contents in a character string */ + char *filename); /* Name of file to read */ + int getfilesize( /* Return size of a binary or ASCII file */ + char *filename); /* Name of file to check */ + int isimlist( /* Return 1 if file is list of FITS or IRAF image files, else 0 */ + char *filename); /* Name of file to check */ + int isimlistd( /* Return 1 if file is list of FITS or IRAF image files, else 0 */ + char *filename, /* Name of file to check */ + char *rootdir); /* Name of root directory for files in list */ + int isfilelist( /* Return 1 if list of readable files, else 0 */ + char *filename, /* Name of file to check */ + char *rootdir); /* Name of root directory for files in list */ + int isfile( /* Return 1 if file is a readable file, else 0 */ + char *filename); /* Name of file to check */ + int istiff( /* Return 1 if TIFF image file, else 0 */ + char *filename); /* Name of file to check */ + int isjpeg( /* Return 1 if JPEG image file, else 0 */ + char *filename); /* Name of file to check */ + int isgif( /* Return 1 if GIF image file, else 0 */ + char *filename); /* Name of file to check */ + int next_line ( /* Return the next line of an ASCII file */ + FILE *diskfile, /* File descriptor for ASCII file */ + int ncmax, /* Maximum number of characters returned */ + char *line); /* Next line (returned) */ + int first_token( /* Return first token from the next line of an ASCII file */ + FILE *diskfile, /* File descriptor for ASCII file */ + int ncmax, /* Maximum number of characters returned */ + char *token); /* First token on next line (returned) */ + int stc2s ( /* Replace character in string with space */ + char *spchar, /* Character to replace with spaces */ + char *string); /* Character string to process */ + int sts2c ( /* Replace spaces in string with character */ + char *spchar, /* Character with which to replace spaces */ + char *string); /* Character string to process */ + +/* Subroutines for access to tokens within a string from fileutil.c */ + int setoken( /* Tokenize a string for easy decoding */ + struct Tokens *tokens, /* Token structure returned */ + char *string, /* character string to tokenize */ + char *cwhite); /* additional whitespace characters + * if = tab, disallow spaces and commas */ + int nextoken( /* Get next token from tokenized string */ + struct Tokens *tokens, /* Token structure returned */ + char *token, /* token (returned) */ + int maxchars); /* Maximum length of token */ + int getoken( /* Get specified token from tokenized string */ + struct Tokens *tokens, /* Token structure returned */ + int itok, /* token sequence number of token + * if <0, get whole string after token -itok + * if =0, get whole string */ + char *token, /* token (returned) */ + int maxchars); /* Maximum length of token */ + +/* Subroutines for translating dates and times in dateutil.c */ + + /* Subroutines to convert between floating point and vigesimal angles */ + + void ang2hr ( /* Fractional degrees to hours as hh:mm:ss.ss */ + double angle, /* Angle in fractional degrees */ + int lstr, /* Maximum number of characters in string */ + char *string); /* Character string (hh:mm:ss.ss returned) */ + void ang2deg ( /* Fractional degrees to degrees as dd:mm:ss.ss */ + double angle, /* Angle in fractional degrees */ + int lstr, /* Maximum number of characters in string */ + char *string); /* Character string (dd:mm:ss.ss returned) */ + double deg2ang ( /* Degrees as dd:mm:ss.ss to fractional degrees */ + char *angle); /* Angle as dd:mm:ss.ss */ + double hr2ang ( /* Hours as hh:mm:ss.ss to fractional degrees */ + char *angle); /* Angle in sexigesimal hours (hh:mm:ss.sss) */ + + /* Subroutines to convert from year and day of year */ + + void doy2dt( /* Year and day of year to yyyy.mmdd hh.mmss */ + int year, /* Year */ + double doy, /* Day of year with fraction */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + double doy2ep( /* Year and day of year to fractional year (epoch) */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + double doy2epb( /* year and day of year to Besselian epoch */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + double doy2epj( /* year and day of year to Julian epoch */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + char *doy2fd( /* year and day of year to FITS date */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + double doy2jd( /* year and day of year to Julian Day */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + double doy2mjd( /* year and day of year to Modified Julian Day */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + double doy2ts( /* year and day of year to seconds since 1950.0 */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + int doy2tsi( /* year and day of year to IRAF seconds since 1980-01-01 */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + time_t doy2tsu( /* year and day of year to Unix seconds since 1970-01-01 */ + int year, /* Year */ + double doy); /* Day of year with fraction */ + + /* Subroutines to convert from date and time */ + + void dt2doy( /* yyyy.mmdd hh.mmss to year and day of year */ + double date, /* Date as yyyy.mmdd + * yyyy = calendar year (e.g. 1973) + * mm = calendar month (e.g. 04 = april) + * dd = calendar day (e.g. 15) */ + double time, /* Time as hh.mmssxxxx + * if time<0, it is time as -(fraction of a day) + * hh = hour of day (0 .le. hh .le. 23) + * nn = minutes (0 .le. nn .le. 59) + * ss = seconds (0 .le. ss .le. 59) + * xxxx = tenths of milliseconds (0 .le. xxxx .le. 9999) */ + int *year, /* Year (returned) */ + double *doy); /* Day of year with fraction (returned) */ + double dt2ep( /* yyyy.ddmm and hh.mmsss to fractional year (epoch) */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + double dt2epb( /* yyyy.ddmm and hh.mmsss to Besselian epoch */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + double dt2epj( /* yyyy.ddmm and hh.mmsss to Julian epoch */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + char *dt2fd( /* yyyy.ddmm and hh.mmsss to FITS date string */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + void dt2i( /* yyyy.ddmm and hh.mmsss to year, month, day, hrs, min, sec */ + double date, /* Date as yyyy.mmdd */ + double time, /* Time as hh.mmssxxxx */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double dt2jd( /* yyyy.ddmm and hh.mmsss to Julian Day */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + double dt2mjd( /* yyyy.ddmm and hh.mmsss to Modified Julian Day */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + double dt2ts( /* yyyy.ddmm and hh.mmsss to seconds since 1950.0 */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + int dt2tsi( /* yyyy.ddmm and hh.mmsss to IRAF seconds since 1980-01-01 */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + time_t dt2tsu( /* yyyy.ddmm and hh.mmsss to Unix seconds since 1970-01-01 */ + double date, /* Date as yyyy.mmdd */ + double time); /* Time as hh.mmssxxxx */ + + /* Subroutines to convert from epoch (various types of fractional year) */ + + void ep2dt( /* Fractional year to yyyy.mmdd hh.mmssss */ + double epoch, /* Date as fractional year */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + void epb2dt( /* Besselian epoch to yyyy.mmdd hh.mmssss */ + double epoch, /* Besselian epoch (fractional 365.242198781-day years) */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + void epj2dt( /* Julian epoch to yyyy.mmdd hh.mmssss */ + double epoch, /* Julian epoch (fractional 365.25-day years) */ + double *date, /* Date as yyyy.mmdd (returned)*/ + double *time); /* Time as hh.mmssxxxx (returned) */ + char *ep2fd( /* Fractional year to FITS date string yyyy-mm-ddThh:mm:ss.ss */ + double epoch); /* Date as fractional year */ + char *epb2fd( /* Besselian epoch to FITS date string yyyy-mm-ddThh:mm:ss.ss */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + char *epj2fd( /* Julian epoch to FITS date string yyyy-mm-ddThh:mm:ss.ss */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + void ep2i( /* Fractional year to year, month, day, hours, min., sec. */ + double epoch, /* Date as fractional year */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + void epb2i( /* Besselian epoch to year, month, day, hours, min., sec. */ + double epoch, /* Besselian epoch (fractional 365.242198781-day years) */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + void epj2i( /* Julian epoch to year, month, day, hours, min., sec. */ + double epoch, /* Julian epoch (fractional 365.25-day years) */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double ep2jd( /* Fractional year to Julian Date */ + double epoch); /* Date as fractional year */ + double epb2jd( /* Besselian epoch to Julian Date */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + double epj2jd( /* Julian epoch to Julian Date */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + double ep2mjd( /* Fractional year to Modified Julian Date */ + double epoch); /* Date as fractional year */ + double epb2mjd( /* Besselian epoch to Modified Julian Date */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + double epj2mjd( /* Julian epoch to Modified Julian Date */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + double ep2epb( /* Fractional year to Besselian epoch */ + double epoch); /* Date as fractional year */ + double ep2epj( /* Fractional year to Julian epoch */ + double epoch); /* Date as fractional year */ + double epb2epj( /* Besselian epoch to Julian epoch */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + double epj2epb( /* Julian epoch to Besselian epoch */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + double epb2ep( /* Besselian epoch to fractional year */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + double epj2ep( /* Julian epoch to fractional year */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + double ep2ts( /* Fractional year to seconds since 1950.0 */ + double epoch); /* Date as fractional year */ + double epb2ts( /* Besselian epoch to seconds since 1950.0 */ + double epoch); /* Besselian epoch (fractional 365.242198781-day years) */ + double epj2ts( /* Julian epoch to seconds since 1950.0 */ + double epoch); /* Julian epoch (fractional 365.25-day years) */ + + /* Convert from FITS standard date string */ + + void fd2dt( /* FITS standard date string to date and time */ + char *string, /* FITS date string, which may be: + * fractional year + * dd/mm/yy (FITS standard before 2000) + * dd-mm-yy (nonstandard use before 2000) + * yyyy-mm-dd (FITS standard after 1999) + * yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + double *date, /* Date as yyyy.mmdd (returned)*/ + double *time); /* Time as hh.mmssxxxx (returned) */ + void fd2doy( /* FITS standard date string to year, day of year */ + char *string, /* FITS date string */ + int *year, /* Year (returned) */ + double *doy); /* Day of year with fraction (returned) */ + double fd2ep( /* FITS standard date string to fractional year (epoch) */ + char *string); /* FITS date string */ + double fd2epb( /* FITS standard date string to Besselian epoch */ + char *string); /* FITS date string */ + double fd2epj( /* FITS standard date string to Julian epoch */ + char *string); /* FITS date string */ + char *fd2fd( /* Any FITS standard date string to ISO FITS date string */ + char *string); /* FITS date string */ + char *fd2of( /* Any FITS standard date string to old FITS date and time */ + char *string); /* FITS date string */ + char *fd2ofd( /* Any FITS standard date string to old FITS date string */ + char *string); /* FITS date string */ + char *fd2oft( /* Any FITS standard date string to old FITS time string */ + char *string); /* FITS date string */ + void fd2i( /* FITS standard date string to year, mon, day, hrs, min, sec */ + char *string, /* FITS date string */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double fd2jd( /* FITS standard date string to Julian Day */ + char *string); /* FITS date string */ + double fd2mjd( /* FITS standard date string to Modified Julian Day */ + char *string); /* FITS date string */ + double fd2ts( /* FITS standard date to seconds since 1950-01-01 */ + char *string); /* FITS date string */ + int fd2tsi( /* FITS standard date to IRAF seconds since 1980-01-01 */ + char *string); /* FITS date string */ + time_t fd2tsu( /* FITS standard date to Unix seconds since 1970-01-01 */ + char *string); /* FITS date string */ + + /* Convert from Julian Day */ + + void jd2doy( /* Julian Day to year and day of year */ + double dj, /* Julian Day */ + int *year, /* Year (returned) */ + double *doy); /* Day of year with fraction (returned) */ + void jd2dt( /* Julian Day to yyyy.mmdd hh.mmssss */ + double dj, /* Julian Day */ + double *date, /* Date as yyyy.mmdd (returned)*/ + double *time); /* Time as hh.mmssxxxx (returned) */ + double jd2ep( /* Julian Day to fractional year */ + double dj); /* Julian Day */ + double jd2epb( /* Julian Day to Besselian epoch */ + double dj); /* Julian Day */ + double jd2epj( /* Julian Day to Julian epoch */ + double dj); /* Julian Day */ + char *jd2fd( /* Julian Day to FITS date string yyyy-mm-ddThh:mm:ss.ss */ + double dj); /* Julian Day */ + void jd2i( /* Julian Day to year, month, day, hours, min., sec. */ + double dj, /* Julian Day */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double jd2mjd( /* Julian Day to Modified Julian day */ + double dj); /* Julian Day */ + double jd2ts( /* Julian Day to seconds since 1950.0 */ + double dj); /* Julian Day */ + time_t jd2tsu( /* Julian Day to Unix seconds since 1970-01-01T00:00 */ + double dj); /* Julian Day */ + int jd2tsi( /* Julian Day to IRAF seconds since 1980-01-01T00:00 */ + double dj); /* Julian Day */ + + /* Convert current local time to various formats */ + + void lt2dt( /* Current local time to date (yyyy.mmdd), time (hh.mmsss) */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + char *lt2fd(void); /* Current local time to FITS ISO date string */ + int lt2tsi(void); /* Current local time to IRAF seconds since 1980-01-01T00:00 */ + time_t lt2tsu(void); /* Current local time to Unix seconds since 1970-01-01T00:00 */ + double lt2ts(void); /* Current local time to IRAF seconds since 1950-01-01T00:00 */ + + /* Convert from Modified Julian Day (JD - 2400000.5) */ + + void mjd2doy( /* Modified Julian Day to year and day of year */ + double dj, /* Modified Julian Day */ + int *year, /* Year (returned) */ + double *doy); /* Day of year with fraction (returned) */ + void mjd2dt( /* Modified Julian Day to yyyy.mmdd hh.mmssss */ + double dj, /* Modified Julian Date */ + double *date, /* Date as yyyy.mmdd (returned)*/ + double *time); /* Time as hh.mmssxxxx (returned) */ + double mjd2ep( /* Modified Julian Day to fractional year */ + double dj); /* Modified Julian Date */ + double mjd2epb( /* Modified Julian Day to Besselian epoch */ + double dj); /* Modified Julian Date */ + double mjd2epj( /* Modified Julian Day to Julian epoch */ + double dj); /* Modified Julian Date */ + char *mjd2fd( /* Modified Julian Day to FITS date yyyy-mm-ddThh:mm:ss.ss */ + double dj); /* Modified Julian Date */ + void mjd2i( /* Modified Julian Day to year, month, day, hours, min, sec */ + double dj, /* Modified Julian Date */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double mjd2jd( /* Modified Julian Day to Julian day */ + double dj); /* Modified Julian Date */ + double mjd2ts( /* Modified Julian Day to seconds since 1950.0 */ + double dj); /* Modified Julian Date */ + + /* Convert from seconds since 1950-01-01 0:00 (JPL Ephemeris time) */ + + void ts2dt( /* Seconds since 1950.0 to yyyy.mmdd hh.mmssss */ + double tsec, /* seconds since 1950.0 */ + double *date, /* Date as yyyy.mmdd (returned)*/ + double *time); /* Time as hh.mmssxxxx (returned) */ + double ts2ep( /* Seconds since 1950.0 to fractional year */ + double tsec); /* seconds since 1950.0 */ + double ts2epb( /* Seconds since 1950.0 to Besselian epoch */ + double tsec); /* seconds since 1950.0 */ + double ts2epj( /* Seconds since 1950.0 to Julian epoch */ + double tsec); /* seconds since 1950.0 */ + char *ts2fd( /* Seconds since 1950.0 to FITS date, yyyy-mm-ddT00:00:00.000 */ + double tsec); /* seconds since 1950.0 */ + void ts2i( /* Seconds since 1950.0 to year, month, day, hours, min, sec */ + double tsec, /* seconds since 1950.0 */ + int *iyr, /* year (returned) */ + int *imon, /* month (returned) */ + int *iday, /* day (returned) */ + int *ihr, /* hours (returned) */ + int *imn, /* minutes (returned) */ + double *sec, /* seconds (returned) */ + int ndsec); /* Number of decimal places in seconds (0=int) */ + double ts2jd( /* Seconds since 1950.0 to Julian Day */ + double tsec); /* seconds since 1950.0 */ + double ts2mjd( /* Seconds since 1950.0 to Modified Julian Day */ + double tsec); /* seconds since 1950.0 */ + + /* Convert from IRAF time (seconds since 1980-01-01 0:00 UT) */ + + char *tsi2fd( /* Seconds since 1980-01-01 to FITS standard date string */ + int isec); /* Seconds past 1980-01-01 */ + double tsi2ts( /* Seconds since 1980-01-01 to seconds since 1950-01-01 */ + int isec); /* Seconds past 1980-01-01 */ + void tsi2dt( /* Seconds since 1980-01-01 to date yyyy.mmdd, time hh.mmssss */ + int isec, /* Seconds past 1980-01-01 */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + + /* Convert from Unix time (seconds since 1970-01-01 0:00 UT) */ + + void tsu2dt( /* Seconds since 1970-01-01 to date yyyy.ddmm, time hh.mmsss */ + time_t isec, /* Seconds past 1970-01-01 */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + char *tsu2fd( /* Seconds since 1970-01-01 to FITS standard date string */ + time_t isec); /* Seconds past 1970-01-01 */ + double tsu2ts( /* Seconds since 1970-01-01 to seconds since 1950-01-01 */ + time_t isec); /* Seconds past 1970-01-01 */ + int tsu2tsi( /* Seconds since 1970-01-01 to local seconds since 1980-01-01 */ + time_t isec); /* Seconds past 1970-01-01 */ + + /* Convert times within a day */ + + char *tsd2fd( /* Seconds since start of day to FITS standard time string */ + double tsec); /* Seconds since start of day */ + double tsd2dt( /* Seconds since start of day to hh.mmsssss */ + double tsec); /* Seconds since start of day */ + + /* Convert from current Universal Time */ + + void ut2dt( /* Current Universal Time to date (yyyy.mmdd), time (hh.mmsss) */ + double *date, /* Date as yyyy.mmdd (returned) */ + double *time); /* Time as hh.mmssxxxx (returned) */ + void ut2doy( /* Current Universal Time to year, day of year */ + int *year, /* Year (returned) */ + double *doy); /* Day of year (returned) */ + double ut2ep(void); /* Current Universal Time to fractional year */ + double ut2epb(void); /* Current Universal Time to Besselian Epoch */ + double ut2epj(void); /* Current Universal Time to Julian Epoch */ + char *ut2fd(void); /* Current Universal Time to FITS ISO date string */ + double ut2jd(void); /* Current Universal Time to Julian Date */ + double ut2mjd(void); /* Current Universal Time to Modified Julian Date */ + int ut2tsi(void); /* Current UT to IRAF seconds since 1980-01-01T00:00 */ + time_t ut2tsu(void); /* Current UT to Unix seconds since 1970-01-01T00:00 */ + double ut2ts(void); /* Current UT to seconds since 1950-01-01T00:00 */ + + int isdate( /* Return 1 if string is FITS old or ISO date */ + char *string); /* Possible FITS date string, which may be: + * dd/mm/yy (FITS standard before 2000) + * dd-mm-yy (nonstandard FITS use before 2000) + * yyyy-mm-dd (FITS standard after 1999) + * yyyy-mm-ddThh:mm:ss.ss (FITS standard after 1999) */ + + /* Ephemeris time conversions (ET, TT, and TDT) */ + + char *et2fd( /* ET (or TDT or TT) in FITS format to UT in FITS format */ + char *string); /* Ephemeris Time as FITS date string (E not T) */ + char *fd2et( /* UT in FITS format to ET (or TDT or TT) in FITS format */ + char *string); /* FITS date string */ + void dt2et( /* yyyy.ddmm and hh.mmsss to Ephemeris Time */ + double *date, /* Date as yyyy.mmdd */ + double *time); /* Time as hh.mmssxxxx + *if time<0, it is time as -(fraction of a day) */ + double jd2jed( /* Convert from Julian Date to Julian Ephemeris Date */ + double dj); /* Julian Date */ + double jed2jd( /* Convert from Julian Ephemeris Date to Julian Date */ + double dj); /* Julian Ephemeris Date */ + double ets2ts( /* ET in seconds since 1950-01-01 to UT in same format */ + double tsec); /* ET in seconds since 1950-01-01 */ + double ts2ets( /* UT in seconds since 1950-01-01 to ET in same format */ + double tsec); /* UT in seconds since 1950-01-01 */ + void edt2dt( /* yyyy.ddmm and hh.mmsss Ephemeris Time to UT */ + double *date, /* Date as yyyy.mmdd */ + double *time); /* Time as hh.mmssxxxx + * If time<0, it is time as -(fraction of a day) */ + double utdt( /* Compute difference between UT and dynamical time (ET-UT) */ + double dj); /* Julian Date (UT) */ + + /* Sidereal Time conversions */ + + char *fd2gst( /* Convert from FITS UT date to Greenwich Sidereal Time */ + char *string); /* FITS date string */ + void dt2gst( /* Convert from UT as yyyy.mmdd hh.mmssss to Greenwich Sidereal Time */ + double *date, /* Date as yyyy.mmdd */ + double *time); /* Time as hh.mmssxxxx + * If time<0, it is time as -(fraction of a day) */ + double jd2gst( /* Calculate Greenwich Sidereal Time given Julian Date */ + double dj); /* Julian Date (UT) */ + double ts2gst( /* Calculate Greenwich Sidereal Time given Universal Time */ + double tsec); /* Time since 1950.0 in UT seconds */ + char *fd2lst( /* Convert from FITS UT date to Local Sidereal Time */ + char *string); /* FITS date string */ + void dt2lst( /* Convert from UT as yyyy.mmdd hh.mmssss to Local Sidereal Time */ + double *date, /* Date as yyyy.mmdd */ + double *time); /* Time as hh.mmssxxxx + * If time<0, it is time as -(fraction of a day) */ + double ts2lst( /* Calculate Local Sidereal Time given Universal Time */ + double tsec); /* Time since 1950.0 in UT seconds */ + double jd2lst( /* Calculate Local Sidereal Time given Julian Date */ + double dj); /* Julian Date (UT) */ + double eqeqnx( /* Compute equation of eqinoxes from Julian Date */ + double dj); /* Julian Date (UT) */ + char *fd2mst( /* Convert from FITS UT date to Mean Sidereal Time */ + char *string); /* FITS date string */ + double jd2mst( /* Convert from Julian Date to Mean Sidereal Time */ + double dj); /* Julian Date (UT) */ + double jd2mst2( /* Convert from Julian Date to Mean Sidereal Time */ + double dj); /* Julian Date (UT) */ + void dt2mst( /* Convert from UT as yyyy.mmdd hh.mmssss to Mean Sidereal Time */ + double *date, /* Date as yyyy.mmdd */ + double *time); /* Time as hh.mmssxxxx + * If time<0, it is time as -(fraction of a day) */ + double lst2dt( /* Calculate UT as hh.mmsss given UT date and + * Local Sidereal Time */ + double date0, /* UT date as yyyy.mmdd */ + double time0); /* LST as hh.mmssss */ + double lst2jd( /* Calculate UT as Julian Date given UT date and + * Local Sidereal Time */ + double sdj); /* Julian Date of desired day at 0:00 UT + sidereal time */ + char *lst2fd( /* Calculate FITS UT date and time given UT date and + * Local Sidereal Time */ + char *string); /* UT Date, LST as yyyy-mm-ddShh:mm:ss.ss */ + char *gst2fd( /* Calculate FITS UT date and time given Greenwich Sidereal Time */ + char *string); /* UT Date, GST as yyyy-mm-ddShh:mm:ss.ss */ + double gst2jd( /* Calculate FITS UT Julian Date given Greenwich Sidereal Time */ + double sdj); /* UT Date, GST as Julian Date */ + char *mst2fd( /* Calculate FITS UT date and time given Mean Sidereal Time */ + char *string); /* UT Date, MST as yyyy-mm-ddShh:mm:ss.ss */ + double mst2jd( /* Calculate FITS UT Julian Date given Mean Sidereal Time */ + double sdj); /* UT Date, MST as Julian Date */ + double ts2mst( /* Calculate Mean Sidereal Time given Universal Time */ + double tsec); /* time since 1950.0 in UT seconds */ + void setlongitude( /* Longitude for sidereal time in or out */ + double longitude); /* longitude of observatory in degrees (+=west) */ + void compnut( /* Compute nutation in longitude and obliquity and mean obliquity*/ + double dj, /* TDB (loosely ET or TT) as Julian Date */ + double *dpsi, /* Nutation in longitude in radians (returned) */ + double *deps, /* Nutation in obliquity in radians (returned) */ + double *eps0); /* Mean obliquity in radians (returned) */ + + /* Heliocentric Julian Date conversions */ + + double mjd2mhjd( /* Convert from Modified Julian Date to Heliocentric MJD */ + double mjd, /* Julian date (geocentric) */ + double ra, /* Right ascension (degrees) */ + double dec, /* Declination (degrees) */ + int sys); /* J2000, B1950, GALACTIC, ECLIPTIC */ + double mjd2hjd( /* Convert from Modified Julian Date to Heliocentric JD */ + double mjd, /* Julian date (geocentric) */ + double ra, /* Right ascension (degrees) */ + double dec, /* Declination (degrees) */ + int sys); /* J2000, B1950, GALACTIC, ECLIPTIC */ + double mhjd2mjd( /* Convert from Heliocentric Modified Julian Date to MJD */ + double mhjd, /* Modified Heliocentric Julian date */ + double ra, /* Right ascension (degrees) */ + double dec, /* Declination (degrees) */ + int sys); /* J2000, B1950, GALACTIC, ECLIPTIC */ + double jd2hjd( /* Convert from Julian Date to Heliocentric Julian Date */ + double dj, /* Julian date (geocentric) */ + double ra, /* Right ascension (degrees) */ + double dec, /* Declination (degrees) */ + int sys); /* J2000, B1950, GALACTIC, ECLIPTIC */ + double hjd2jd( /* Convert from Heliocentric Julian Date to Julian Date */ + double dj, /* Heliocentric Julian date */ + double ra, /* Right ascension (degrees) */ + double dec, /* Declination (degrees) */ + int sys); /* J2000, B1950, GALACTIC, ECLIPTIC */ + + void setdatedec( /* Set number of decimal places in FITS dates */ + int nd); /* Number of decimal places in FITS dates */ + +#else /* K&R prototypes */ + +/* FITS file access subroutines in fitsfile.c */ +extern int fitsropen(); +extern char *fitsrhead(); +extern char *fitsrtail(); +extern char *fitsrimage(); +extern char *fitsrfull(); +extern char *fitsrsect(); +extern int fitswhead(); +extern int fitswexhead(); +extern int fitswext(); +extern int fitswhdu(); +extern int fitswimage(); +extern int fitscimage(); +extern int isfits(); /* Return 1 if file is a FITS file */ +extern void fitserr(); /* Print FITS error message to stderr */ +extern void setfitsinherit(); /* Set flag to append primary data header */ +extern int fitsheadsize(); /* Return size of fitsheader in bytes */ + +/* FITS table file access subroutines in fitsfile.c */ +extern int fitsrtopen(); +extern int fitsrthead(); +extern void fitsrtlset(); +extern int fitsrtline(); +extern short ftgeti2(); +extern int ftgeti4(); +extern float ftgetr4(); +extern double ftgetr8(); +extern int ftgetc(); +extern void moveb(); /* Copy nbytes bytes from source+offs to dest+offd */ + +/* IRAF file access subroutines in imhfile.c */ +extern char *irafrhead(); +extern char *irafrimage(); +extern int irafwhead(); +extern int irafwimage(); +extern int isiraf(); +extern char *iraf2fits(); +extern char *fits2iraf(); + +/* Image pixel access subroutines in imio.c */ +extern double getpix(); /* Read one pixel from any data type 2-D array (0,0)*/ +extern double getpix1(); /* Read one pixel from any data type 2-D array (1,1)*/ +extern double maxvec(); /* Get maximum value in vector from a image */ +extern double minvec(); /* Get minimum value in vector from a image */ +extern void putpix(); /* Write one pixel to any data type 2-D array (0,0)*/ +extern void putpix1(); /* Write one pixel to any data type 2-D array (1,1) */ +extern void addpix(); /* Add to one pixel in any data type 2-D array (0,0)*/ +extern void addpix1(); /* Add to one pixel in any data type 2-D array (1,1)*/ +extern void movepix(); /* Move one pixel value between two 2-D arrays (0,0) */ +extern void movepix1(); /* Move one pixel value between two 2-D arrays (1,1) */ +extern void addvec(); /* Add constant to vector from 2-D array */ +extern void multvec(); /* Multiply vector from 2-D array by a constant */ +extern void getvec(); /* Read vector from 2-D array */ +extern void putvec(); /* Write vector into 2-D array */ +extern void fillvec(); /* Write constant into a vector */ +extern void fillvec1(); /* Write constant into a vector */ +extern void imswap(); /* Swap alternating bytes in a vector */ +extern void imswap2(); /* Swap bytes in a vector of 2-byte (short) integers */ +extern void imswap4(); /* Reverse bytes in a vector of 4-byte numbers */ +extern void imswap8(); /* Reverse bytes in a vector of 8-byte numbers */ +extern int imswapped(); /* Return 1 if machine byte order is not FITS order */ + +/* File utilities from fileutil.c */ +extern int getfilelines(); +extern char *getfilebuff(); +extern int getfilesize(); +extern int isimlist(); +extern int isimlistd(); +extern int isfilelist(); +extern int isfile(); +extern int istiff(); +extern int isjpeg(); +extern int isgif(); +extern int next_line(); +extern int first_token(); + +/* Subroutines for access to tokens within a string from fileutil.c */ +int setoken(); /* Tokenize a string for easy decoding */ +int nextoken(); /* Get next token from tokenized string */ +int getoken(); /* Get specified token from tokenized string */ + +/* Subroutines for translating dates and times in dateutil.c */ + +void ang2hr(); /* Fractional degrees to hours as hh:mm:ss.ss */ +void ang2deg(); /* Fractional degrees to degrees as dd:mm:ss.ss */ +double deg2ang(); /* Degrees as dd:mm:ss.ss to fractional degrees */ +double hr2ang(); /* Hours as hh:mm:ss.ss to fractional degrees */ + +void doy2dt(); /* year and day of year to yyyy.mmdd hh.mmss */ +double doy2ep(); /* year and day of year to fractional year (epoch) */ +double doy2epb(); /* year and day of year to Besselian epoch */ +double doy2epj(); /* year and day of year to Julian epoch */ +char *doy2fd(); /* year and day of year to FITS date */ +double doy2jd(); /* year and day of year to Julian date */ +double doy2mjd(); /* year and day of year to modified Julian date */ +double doy2ts(); /* year and day of year to seconds since 1950.0 */ +int doy2tsi(); /* year and day of year to IRAF seconds since 1980-01-01 */ + +time_t doy2tsu(); /* year and day of year to Unix seconds since 1970-01-01 */ +void dt2doy(); /* yyyy.mmdd hh.mmss to year and day of year */ +double dt2ep(); /* yyyy.ddmm and hh.mmsss to fractional year (epoch) */ +double dt2epb(); /* yyyy.ddmm and hh.mmsss to Besselian epoch */ +double dt2epj(); /* yyyy.ddmm and hh.mmsss to Julian epoch */ +char *dt2fd(); /* yyyy.ddmm and hh.mmsss to FITS date string */ +void dt2i(); /* yyyy.ddmm and hh.mmsss to year, month, day, hrs, min, sec */ +double dt2jd(); /* yyyy.ddmm and hh.mmsss to Julian date */ +double dt2mjd(); /* yyyy.ddmm and hh.mmsss to modified Julian date */ +double dt2ts(); /* yyyy.ddmm and hh.mmsss to seconds since 1950.0 */ +int dt2tsi(); /* yyyy.ddmm and hh.mmsss to IRAF seconds since 1980-01-01 */ +time_t dt2tsu(); /* yyyy.ddmm and hh.mmsss to Unix seconds since 1970-01-01 */ + +void ep2dt(); /* Fractional year to yyyy.mmdd hh.mmssss */ +void epb2dt(); /* Besselian epoch to yyyy.mmdd hh.mmssss */ +void epj2dt(); /* Julian epoch to yyyy.mmdd hh.mmssss */ +char *ep2fd(); /* Fractional year to FITS date string yyyy-mm-ddThh:mm:ss.ss */ +char *epb2fd(); /* Besselian epoch to FITS date string yyyy-mm-ddThh:mm:ss.ss */ +char *epj2fd(); /* Julian epoch to FITS date string yyyy-mm-ddThh:mm:ss.ss */ +void ep2i(); /* Fractional year to year, month, day, hours, min., sec. */ +void epb2i(); /* Besselian epoch to year, month, day, hours, min., sec. */ +void epj2i(); /* Julian epoch to year, month, day, hours, min., sec. */ +double ep2jd(); /* Fractional year to Julian Date */ +double epb2jd(); /* Besselian epoch to Julian Date */ +double epj2jd(); /* Julian epoch to Julian Date */ +double ep2mjd(); /* Fractional year to modified Julian Date */ +double epb2mjd(); /* Besselian epoch to modified Julian Date */ +double epj2mjd(); /* Julian epoch to modified Julian Date */ +double ep2epb(); /* Fractional year to Besselian epoch */ +double ep2epj(); /* Fractional year to Julian epoch */ +double epb2epj(); /* Besselian epoch to Julian epoch */ +double epj2epb(); /* Julian epoch to Besselian epoch */ +double epb2ep(); /* Besselian epoch to fractional year */ +double epj2ep(); /* Julian epoch to fractional year */ +double ep2ts(); /* Fractional year to seconds since 1950.0 */ +double epb2ts(); /* Besselian epoch to seconds since 1950.0 */ +double epj2ts(); /* Julian epoch to seconds since 1950.0 */ + +void fd2dt(); /* FITS standard date string to Julian date */ +void fd2doy(); /* FITS standard date string to year, day of year */ +double fd2ep(); /* FITS standard date string to fractional year (epoch) */ +double fd2epb(); /* FITS standard date string to Besselian epoch */ +double fd2epj(); /* FITS standard date string to Julian epoch */ +char *fd2fd(); /* Any FITS standard date string to ISO FITS date string */ +char *fd2of(); /* Any FITS standard date string to old FITS date and time */ +char *fd2ofd(); /* Any FITS standard date string to old FITS date string */ +char *fd2oft(); /* Any FITS standard date string to old FITS time string */ +void fd2i(); /* FITS standard date string to year, mon, day, hrs, min, sec */ +double fd2jd(); /* FITS standard date string to Julian date */ +double fd2mjd(); /* FITS standard date string to modified Julian date */ +double fd2ts(); /* FITS standard date to seconds since 1950-01-01 */ +int fd2tsi(); /* FITS standard date to IRAF seconds since 1980-01-01 */ +time_t fd2tsu(); /* FITS standard date to Unix seconds since 1970-01-01 */ +void jd2doy(); /* Julian date to year and day of year */ +void jd2dt(); /* Julian date to yyyy.mmdd hh.mmssss */ +double jd2ep(); /* Julian date to fractional year */ +double jd2epb(); /* Julian date to Besselian epoch */ +double jd2epj(); /* Julian date to Julian epoch */ +char *jd2fd(); /* Julian date to FITS date string yyyy-mm-ddThh:mm:ss.ss */ +void jd2i(); /* Julian date to year, month, day, hours, min., sec. */ +double jd2mjd(); /* Julian date to modified Julian date */ +double jd2ts(); /* Julian date to seconds since 1950.0 */ +time_t jd2tsu(); /* Julian date to Unix seconds since 1970-01-01T00:00 */ +int jd2tsi(); /* Julian date to IRAF seconds since 1980-01-01T00:00 */ + +void lt2dt(); /* Current local time to date (yyyy.mmdd), time (hh.mmsss) */ +char *lt2fd(); /* Current local time to FITS ISO date string */ +int lt2tsi(); /* Current local time to IRAF seconds since 1980-01-01T00:00 */ +time_t lt2tsu(); /* Current local time to Unix seconds since 1970-01-01T00:00 */ +double lt2ts(); /* Current local time to IRAF seconds since 1950-01-01T00:00 */ + +void mjd2doy(); /* Convert from Modified Julian Date to Day of Year */ +void mjd2dt(); /* Modified Julian date to yyyy.mmdd hh.mmssss */ +double mjd2ep(); /* Modified Julian date to fractional year */ +double mjd2epb(); /* Modified Julian date to Besselian epoch */ +double mjd2epj(); /* Modified Julian date to Julian epoch */ +char *mjd2fd(); /* Modified Julian date to FITS date yyyy-mm-ddThh:mm:ss.ss */ +void mjd2i(); /* Modified Julian date to year, month, day, hours, min, sec */ +double mjd2jd(); /* Modified Julian date to Julian date */ +double mjd2ts(); /* Modified Julian date to seconds since 1950.0 */ + +void ts2dt(); /* Seconds since 1950.0 to yyyy.mmdd hh.mmssss */ +double ts2ep(); /* Seconds since 1950.0 to fractional year */ +double ts2epb(); /* Seconds since 1950.0 to Besselian epoch */ +double ts2epj(); /* Seconds since 1950.0 to Julian epoch */ +char *ts2fd(); /* Seconds since 1950.0 to FITS date, yyyy-mm-ddT00:00:00.000 */ +void ts2i(); /* Seconds since 1950.0 to year, month, day, hours, min, sec */ +double ts2jd(); /* Seconds since 1950.0 to Julian date */ +double ts2mjd(); /* Seconds since 1950.0 to modified Julian date */ +char *tsi2fd(); /* Seconds since 1980-01-01 to FITS standard date string */ +double tsi2ts(); /* Seconds since 1980-01-01 to seconds since 1950-01-01 */ +double tsi2ts(); /* Seconds since 1980-01-01 to seconds since 1950-01-01 */ +void tsi2dt(); /* Seconds since 1980-01-01 to date yyyy.mmdd, time hh.mmssss */ +void tsu2dt(); /* Seconds since 1970-01-01 to date yyyy.ddmm, time hh.mmsss */ +char *tsu2fd(); /* Seconds since 1970-01-01 to FITS standard date string */ +char *tsd2fd(); /* Seconds since start of day to FITS standard time string */ +double tsd2dt(); /* Seconds since start of day to hh.mmsssss */ +double tsu2ts(); /* Seconds since 1970-01-01 to seconds since 1950-01-01 */ +int tsu2tsi(); /* Seconds since 1970-01-01 to local seconds since 1980-01-01 */ +int isdate(); /* Return 1 if string is FITS old or ISO date */ +void ut2dt(); /* Current Universal Time to date (yyyy.mmdd), time (hh.mmsss) */ +void ut2doy(); /* Current Universal Time to year, day of year */ +double ut2ep(); /* Current Universal Time to fractional year */ +double ut2epb(); /* Current Universal Time to Besselian Epoch */ +double ut2epj(); /* Current Universal Time to Julian Epoch */ +char *ut2fd(); /* Current Universal Time to FITS ISO date string */ +double ut2jd(); /* Current Universal Time to Julian Date */ +double ut2mjd(); /* Current Universal Time to Modified Julian Date */ +int ut2tsi(); /* Current UT to IRAF seconds since 1980-01-01T00:00 */ +time_t ut2tsu(); /* Current UT to Unix seconds since 1970-01-01T00:00 */ +double ut2ts(); /* Current UT to IRAF seconds since 1950-01-01T00:00 */ +int sts2c(); /* Replaces spaces in a string with a specified character */ +int stc2s(); /* Replaces a specified character in a string with spaces */ +char *et2fd(); /* ET (or TDT or TT) in FITS format to UT in FITS format */ +char *fd2et(); /* UT in FITS format to ET (or TDT or TT) in FITS format */ +double jd2jed(); /* Convert from Julian Date to Julian Ephemeris Date */ +double jed2jd(); /* Convert from Julian Ephemeris Date to Julian Date */ +double ets2ts(); /* ET in seconds since 1950-01-01 to UT in same format */ +double ts2ets(); /* UT in seconds since 1950-01-01 to ET in same format */ +void dt2et(); /* yyyy.ddmm and hh.mmsss to Ephemeris Time */ +void edt2dt(); /* yyyy.ddmm and hh.mmsss Ephemeris Time to UT */ +double utdt(); /* Compute difference between UT and dynamical time (ET-UT) */ +char *fd2gst(); /* Convert from FITS UT date to Greenwich Sidereal Time */ +void dt2gst(); /* Convert from UT as yyyy.mmdd hh.mmssss to Greenwich Sidereal Time */ +double jd2gst(); /* Calculate Greenwich Sidereal Time given Julian Date */ +double ts2gst(); /* Calculate Greenwich Sidereal Time given Universal Time */ +char *fd2lst(); /* Convert from FITS UT date to Local Sidereal Time */ +void dt2lst(); /* Convert from UT as yyyy.mmdd hh.mmssss to Local Sidereal Time */ +double ts2lst(); /* Calculate Local Sidereal Time given Universal Time */ +double jd2lst(); /* Calculate Local Sidereal Time given Julian Date */ +double eqeqnx(); /* Compute equation of eqinoxes from Julian Date */ +char *fd2mst(); /* Convert from FITS UT date to Mean Sidereal Time */ +double jd2mst(); /* Convert from Julian Date to Mean Sidereal Time */ +double jd2mst2(); /* Convert from Julian Date to Mean Sidereal Time */ +void dt2mst(); /* Convert from UT as yyyy.mmdd hh.mmssss to Mean Sidereal Time */ +double lst2ts(); /* Calculate Universal Time given Local Sidereal Time */ +double lst2dt(); /* Calculate UT as yyyy.mmdd hh.mmsss given UT date and Local Sidereal Time */ +double lst2jd(); /* Calculate UT as Julian Date given UT date and Local Sidereal Time */ +char *lst2fd(); /* Calculate FITS UT date and time given UT date and Local Sidereal Time */ +char *gst2fd(); /* Calculate FITS UT date and time given Greenwich Sidereal Time */ +double gst2jd(); /* Calculate FITS UT Julian Date given Greenwich Sidereal Time */ +char *mst2fd(); /* Calculate FITS UT date and time given Mean Sidereal Time */ +double mst2jd(); /* Calculate FITS UT Julian Date given Mean Sidereal Time */ +char *fd2mst(); /* Convert from FITS UT date to Mean Sidereal Time */ +void dt2mst(); /* Convert from UT as yyyy.mmdd hh.mmssss to Mean Sidereal Time */ +double ts2mst(); /* Calculate Mean Sidereal Time given Universal Time */ +double mjd2mhjd(); /* Convert from Modified Julian Date to Heliocentric MJD */ +double mjd2hjd(); /* Convert from Modified Julian Date to Heliocentric JD */ +double mhjd2mjd(); /* Convert from Heliocentric Modified Julian Date to MJD */ +double jd2hjd(); /* Convert from Julian Date to Heliocentric Julian Date */ +double jd2mhjd(); /* Convert from Julian Date to Modified Heliocentric JD */ +double hjd2jd(); /* Convert from Heliocentric Julian Date to Julian Date */ +double hjd2mjd(); /* Convert from Heliocentric Julian Date to Modified JD */ +double hjd2mhjd(); /* Convert from Heliocentric Julian Date to Modified HJD */ +void setdatedec(); /* Set number of decimal places in FITS dates */ +void setlongitude(); /* Longitude for sidereal time in or out */ + +void compnut(); /* Compute nutation in longitude and obliquity and mean obliquity*/ + +#endif /* __STDC__ */ + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* fitsfile_h_ */ + +/* May 31 1996 Use stream I/O for reading as well as writing + * Jun 12 1996 Add byte-swapping subroutines + * Jul 10 1996 FITS header now allocated in subroutines + * Jul 17 1996 Add FITS table column extraction subroutines + * Aug 6 1996 Add MOVEPIX, HDEL and HCHANGE declarations + * + * Oct 10 1997 FITS file opening subroutines now return int instead of FILE * + * + * May 27 1998 Split off fitsio and imhio subroutines to fitsio.h + * Jun 4 1998 Change fits2iraf from int to int * + * Jul 24 1998 Make IRAF header char instead of int + * Aug 18 1998 Change name to fitsfile.h from fitsio.h + * Oct 5 1998 Add isiraf() and isfits() + * Oct 7 1998 Note separation of imhfile.c into two files + * + * Jul 15 1999 Add fileutil.c subroutines + * Sep 28 1999 Add (1,1)-based image access subroutines + * Oct 21 1999 Add fitswhead() + * Nov 2 1999 Add date utilities from wcscat.h + * Nov 23 1999 Add fitscimage() + * Dec 15 1999 Fix misdeclaration of *2fd() subroutines, add fd2i(), dt2i() + * Dec 20 1999 Add isdate() + * + * Jan 20 2000 Add conversions to and from Besselian and Julian epochs + * Jan 21 2000 Add conversions to old FITS date and time + * Jan 26 2000 Add conversion to modified Julian date (JD - 2400000.5 + * Mar 22 2000 Add lt2* and ut2* to get current time as local and UT + * Mar 24 2000 Add tsi2* and tsu2* to convert IRAF and Unix seconds + * Sep 8 2000 Improve comments + * + * Apr 24 2001 Add length of column name to column data structure + * May 22 2001 Add day of year date conversion subroutines + * Sep 25 2001 Add isfilelist() and isfile() + * + * Jan 8 2002 Add sts2c() and stc2s() + * Apr 8 2002 Change all long declarations to time_t for compatibility + * Jun 18 2002 Add fitserr() to print error messages + * Aug 30 2002 Add Ephemeris Time date conversions + * Sep 10 2002 Add Sidereal Time conversions + * Oct 21 2002 Add fitsrsect() to read sections of FITS images + * + * Mar 5 2003 Add isimlistd() to check image lists with root directory + * Aug 20 2003 Add fitsrfull() to read n-dimensional simple FITS images + * + * Feb 27 2004 Add fillvec() and fillvec1() + * May 3 2004 Add setfitsinherit() + * May 6 2004 Add fitswexhead() + * Aug 27 2004 Add fitsheadsize() + * + * Oct 14 2005 Add tsd2fd(), tsd2dt(), epj2ep(), epb2ep(), tsi2dt() + * + * Feb 23 2006 Add fitsrtail() to read appended FITS header + * Feb 23 2006 Add istiff(), isjpeg(), isgif() to check TIFF, JPEG, GIF files + * Sep 6 2006 Add heliocentric time conversions + * Oct 5 2006 Add local sidereal time conversions + * + * Jan 9 2007 Add ANSI prototypes + * Jan 11 2007 Add token subroutines from catutil.c/wcscat.h to fileutil.c + * Jun 11 2007 Add minvec() subroutine in imio.c + * Nov 28 2007 Add kform format to FITS table keyword data structure + * + * Sep 8 2008 Add ag2hr(), ang2deg(), deg2ang(), and hr2ang() + * + * Sep 25 2009 Add moveb() + * + * Jun 20 2014 Add next_line() + */ diff --git a/tksao/wcssubs/fitshead.h b/tksao/wcssubs/fitshead.h new file mode 100644 index 0000000..1212709 --- /dev/null +++ b/tksao/wcssubs/fitshead.h @@ -0,0 +1,438 @@ +/*** File fitshead.h FITS header access subroutines + *** January 9, 2007 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2007 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +/* Declarations for subroutines in hget.c, hput.c, and iget.c */ + +#ifndef _fitshead_h_ +#define _fitshead_h_ + +#include <sys/types.h> + +#ifdef __cplusplus /* C++ prototypes */ +extern "C" { +#endif + + +#ifdef __STDC__ /* Full ANSI prototypes */ + +/* Subroutines in hget.c */ + int hgeti2( /* Extract short value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + short* val); /* short integer value (returned) */ + int hgeti4c( /* Extract int value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + const char* wchar, /* WCS to use (A-Z or null) */ + int* val); /* integer value (returned) */ + int hgeti4( /* Extract int value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + int* val); /* integer value (returned) */ + int hgetr4( /* Extract float value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + float* val); /* float value (returned) */ + int hgetr8c( /* Extract double value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + const char* wchar, /* WCS to use (A-Z or null) */ + double* val); /* double value (returned) */ + int hgetr8( /* Extract double value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + double* val); /* double value (returned) */ + int hgetra( /* Extract right ascension from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + double* ra); /* RA in degrees (returned) */ + int hgetdec( /* Extract declination from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + double* dec); /* Dec in degrees (returned) */ + int hgetdate( /* Extract date from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + double* date); /* Date in fractional years (returned) */ + int hgetl( /* Extract boolean value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + int* lval); /* 1 if T, 0 if F (returned) */ + int hgetsc( /* Extract string value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + const char* wchar, /* WCS to use (A-Z or null) */ + const int lstr, /* maximum length of returned string */ + char* string); /* null-terminated string value (returned) */ + int hgets( /* Extract string value from FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + const int lstr, /* maximum length of returned string */ + char* string); /* null-terminated string value (returned) */ + int hgetm ( /* Extract string from multiple keywords */ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + const int lstr, /* maximum length of returned string */ + char* string); /* null-terminated string value (returned) */ + int hgetndec( /* Find number of decimal places in FITS value*/ + const char* hstring, /* FITS header string */ + const char* keyword, /* FITS keyword */ + int* ndec); /* number of decimal places (returned) */ + + char* hgetc( /* Return pointer to value for FITS keyword */ + const char* hstring, /* FITS header string */ + const char* keyword); /* FITS keyword */ + + char* ksearch( /* Return pointer to keyword in FITS header */ + const char* hstring, /* FITS header string */ + const char* keyword); /* FITS keyword */ + char *blsearch ( + const char* hstring, /* FITS header string */ + const char* keyword); /* FITS keyword */ + + char *strsrch ( /* Find string s2 within string s1 */ + const char* s1, /* String to search */ + const char* s2); /* String to look for */ + char *strnsrch ( /* Find string s2 within string s1 */ + const char* s1, /* String to search */ + const char* s2, /* String to look for */ + const int ls1); /* Length of string being searched */ + + char *strcsrch ( /* Find string s2 within string s1 (no case) */ + const char* s1, /* String to search */ + const char* s2); /* String to look for */ + char *strncsrch ( /* Find string s2 within string s1 (no case) */ + const char* s1, /* String to search */ + const char* s2, /* String to look for */ + const int ls1); /* Length of string being searched */ + + int hlength( /* Set length of unterminated FITS header */ + const char *header, /* FITS header */ + const int lhead); /* Allocated length of FITS header */ + int gethlength( /* Get length of current FITS header */ + char* header); /* FITS header */ + + double str2ra( /* Return RA in degrees from string */ + const char* in); /* Character string (hh:mm:ss.sss or dd.dddd) */ + double str2dec( /* Return Dec in degrees from string */ + const char* in); /* Character string (dd:mm:ss.sss or dd.dddd) */ + + int isnum( /* Return 1 if number, else 0 */ + const char* string); /* Character string which may be a number */ + int notnum( /* Return 0 if number, else 1 */ + const char* string); /* Character string which may be a number */ + int numdec( /* Return number of decimal places in number */ + const char* string); /* Character string which may be a number */ + void strfix( /* Clean up extraneous characters in string */ + char* string, /* Character string which may be a number */ + int fillblank, /* If 1, blanks are replaced by underscores */ + int dropzero); /* If 1, drop trailing zeroes from string */ + + char *getltime(void); /* Return current local time in ISO format */ + char *getutime(void); /* Return current UT as an ISO-format string */ + +/* Subroutines in iget.c */ + int mgetstr( /* Extract string from multiline FITS keyword */ + const char* hstring, /* FITS header string */ + const char* mkey, /* FITS keyword root _n added for extra lines */ + const char* keyword, /* IRAF keyword */ + const int lstr, /* maximum length of returned string */ + char* string); /* null-terminated string value (returned) */ + int mgeti4( /* Extract int from multiline FITS keyword */ + const char* hstring, /* FITS header string */ + const char* mkey, /* FITS keyword root _n added for extra lines */ + const char* keyword, /* IRAF keyword */ + int* ival); /* int keyword value (returned) */ + int mgetr8( /* Extract double from multiline FITS keyword */ + const char* hstring, /* FITS header string */ + const char* mkey, /* FITS keyword root _n added for extra lines */ + const char* keyword, /* IRAF keyword */ + double* dval); /* double keyword value (returned) */ + int igeti4( /* Extract int from IRAF keyword string */ + const char* hstring, /* Multiline IRAF keyword string value */ + const char* keyword, /* IRAF keyword */ + int* val); /* int value (returned) */ + int igetr4( /* Extract float from IRAF keyword string */ + const char* hstring, /* Multiline IRAF keyword string value */ + const char* keyword, /* IRAF keyword */ + float* val); /* float value (returned) */ + int igetr8( /* Extract double from IRAF keyword string */ + const char* hstring, /* Multiline IRAF keyword string value */ + const char* keyword, /* IRAF keyword */ + double* val); /* double value (returned) */ + int igets( /* Extract string from IRAF keyword string */ + const char* hstring, /* Multiline IRAF keyword string value */ + const char* keyword, /* IRAF keyword */ + const int lstr, /* maximum length of returned string */ + char* string); /* null-terminated string value (returned) */ + char *igetc( /* Extract string from IRAF keyword string */ + const char* hstring, /* Multiline IRAF keyword string value */ + const char* keyword); /* IRAF keyword */ + +/* Subroutines in hput.c */ +/* All hput* routines return 0 if successful, else -1 */ + int hputi2( /* Implant short value into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + short ival); /* short value */ + int hputi4( /* Implant int value into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const int ival); /* int value */ + int hputr4( /* Implant float value into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const float* rval); /* float (4 byte) value */ + int hputr8( /* Implant short into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const double dval); /* double value */ + int hputnr8( /* double with specified number of decimal places */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const int ndec, /* Number of decimal places in keyword value */ + const double dval); /* double value */ + int hputs( /* Quoted character string into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const char* cval); /* Character string value */ + int hputm( /* Quoted character string, mutiple keywords */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const char* cval); /* Character string value */ + int hputcom( /* Add comment to keyword line in FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const char* comment); /* Comment string */ + int hputra( /* Right ascension in degrees into hh:mm:ss.sss */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const double ra); /* Right ascension in degrees */ + int hputdec( /* Declination in degrees into dd:mm:ss.ss */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const double dec); /* Declination in degrees */ + int hputl( /* Implant boolean value into FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const int lval); /* 0->F, else ->T */ + int hputc( /* Implant character string without quotes */ + char* hstring, /* FITS header string (modified) */ + const char* keyword, /* FITS keyword */ + const char* cval); /* Character string value */ + + int hdel( /* Delete a keyword line from a FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword); /* FITS keyword to delete */ + int hadd( /* Add a keyword line from a FITS header */ + char* hplace, /* Location in FITS header string (modified) */ + const char* keyword); /* FITS keyword to add */ + int hchange( /* Change a keyword name in a FITS header */ + char* hstring, /* FITS header string (modified) */ + const char* keyword1, /* Current FITS keyword name */ + const char* keyword2); /* New FITS keyword name */ + + void ra2str( /* Convert degrees to hh:mm:ss.ss */ + char *string, /* Character string (returned) */ + int lstr, /* Length of string */ + const double ra, /* Right ascension in degrees */ + const int ndec); /* Number of decimal places in seconds */ + void dec2str( /* Convert degrees to dd:mm:ss.ss */ + char *string, /* Character string (returned) */ + int lstr, /* Length of string */ + const double dec, /* Declination in degrees */ + const int ndec); /* Number of decimal places in arcseconds */ + void deg2str( /* Format angle into decimal degrees string */ + char *string, /* Character string (returned) */ + int lstr, /* Length of string */ + const double deg, /* Angle in degrees */ + const int ndec); /* Number of decimal places in degrees */ + void num2str( /* Format number into string */ + char *string, /* Character string (returned) */ + const double num, /* Number */ + const int field, /* Total field size in characters */ + const int ndec); /* Number of decimal places */ + void setheadshrink( /* 0 to keep blank line when keyword deleted */ + const int hsh); /* 1 to shrink header by one line */ + void setleaveblank( /* 1 to keep blank line where keyword deleted */ + const int hsh); /* 0 to shrink header by one line */ + +#else /* K&R prototypes */ + +/* Subroutines in hget.c */ + +/* Extract a value from a FITS header for given keyword */ +extern int hgeti4(); /* int (Multiple WCS) */ +extern int hgeti4c(); /* int */ +extern int hgeti2(); /* short */ +extern int hgetr4(); /* float */ +extern int hgetr8(); /* double */ +extern int hgetr8c(); /* double (Multiple WCS) */ +extern int hgetra(); /* Right ascension in degrees from string */ +extern int hgetdec(); /* Declination in degrees from string */ +extern int hgetdate(); /* Date in years from FITS date string */ +extern int hgetl(); /* T->1, F->0 from FITS logical entry */ +extern int hgets(); /* Previously allocated string */ +extern int hgetsc(); /* Previously allocated string (Multiple WCS) */ +extern int hgetm(); /* Previously allocated string from multiple keywords */ +extern char *hgetc(); /* Return pointer to string */ +extern int hgetndec(); /* Number of decimal places in keyword value */ + +/* Subroutines to convert strings to RA and Dec in degrees */ +extern double str2ra(); +extern double str2dec(); + +/* Check to see whether a string is a number or not */ +extern int isnum(); +extern int notnum(); +extern int decnum(); + +/* Find given keyword entry in FITS header */ +extern char *ksearch(); + +/* Find beginning of fillable blank line before FITS header keyword */ +extern char *blsearch(); + +/* Search for substring s2 within string s1 */ +extern char *strsrch (); /* s1 null-terminated */ +extern char *strnsrch (); /* s1 ls1 characters long */ +extern char *strcsrch (); /* s1 null-terminated (case-insensitive) */ +extern char *strncsrch (); /* s1 ls1 characters long (case-insensitive) */ +extern void strfix(); /* Drop or change extraneous characters in string */ + +/* Set length of header which is not null-terminated */ +extern int hlength(); + +/* Get length of current FITS header */ +extern int gethlength(); + +/* Subroutines in iget.c */ +extern int mgetstr(); /* Previously allocated string from multiline keyword */ +extern int mgetr8(); /* double from multiline keyword */ +extern int mgeti4(); /* int from multiline keyword */ +extern int igeti4(); /* long integer from IRAF compound keyword value */ +extern int igetr4(); /* real from IRAF compound keyword value */ +extern int igetr8(); /* double from IRAF compound keyword value */ +extern int igets(); /* character string from IRAF compound keyword value */ +extern char *igetc(); /* Extract string from IRAF keyword string */ + +/* Subroutines in hput.c */ + +/* Implant a value into a FITS header for given keyword */ +extern int hputi4(); /* int */ +extern int hputi2(); /* short */ +extern int hputr4(); /* float */ +extern int hputr8(); /* double */ +extern int hputnr8(); /* double with specified number of decimal places */ +extern int hputra(); /* Right ascension in degrees into hh:mm:ss.sss */ +extern int hputdec(); /* Declination in degrees into dd:mm:ss.ss */ +extern int hputl(); /* 0 -> F, else T FITS logical entry */ +extern int hputs(); /* Quoted character string */ +extern int hputm(); /* Quoted character string into mutiple keywords */ +extern int hputc(); /* Character string without quotes (returns 0 if OK) */ +extern int hputcom(); /* Comment after keyword=value (returns 0 if OK) */ + +extern int hdel(); /* Delete a keyword line from a FITS header */ +extern int hadd(); /* Add a keyword line to a FITS header */ +extern int hchange(); /* Change a keyword name in a FITS header */ +extern void setheadshrink(); /* Set flag for deleted keyword space disposition*/ +extern void setleaveblank(); /* Set flag for deleted keyword space disposition*/ + +/* Subroutines to convert RA and Dec in degrees to strings */ +extern void ra2str(); +extern void dec2str(); + +extern void deg2str(); +extern void num2str(); +extern int numdec(); /* Return number of decimal places in number */ + +extern char *getltime(); /* Return current local time in ISO format */ +extern char *getutime(); /* Return current UT as an ISO-format string */ + +#endif /* __STDC__ */ + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* fitshead_h_ */ + +/* Apr 26 1996 Add HGETDATE to get year from date string + * May 22 1996 Return double from STR2RA and STR2DEC + * May 31 1996 Use stream I/O for reading as well as writing + * Jun 12 1996 Add byte-swapping subroutines + * Jul 10 1996 FITS header now allocated in subroutines + * Jul 17 1996 Add FITS table column extraction subroutines + * Jul 19 1996 Add declarations for header implanting subroutines + * Aug 5 1996 Add HLENGTH for FITS headers which are not null-terminated + * Aug 5 1996 Add STRNSRCH for FITS headers which are not null-terminated + * Aug 6 1996 Add HPUTNR8 to save a specified number of decimal places + * Aug 6 1996 Add MOVEPIX, HDEL and HCHANGE declarations + * Nov 1 1996 Add DEG2STR + * Dec 12 1996 Add ISNUM + * + * Oct 10 1997 FITS file opening subroutines now return int instead of FILE * + * + * Mar 12 1998 Add NOTNUM + * Apr 30 1998 Clean up declarations and add more comments + * May 12 1998 Add MGETS, MGETR8, MGETI4 for IRAF multi-line keywords + * May 26 1998 Add HGETNDEC for number of decimal places in keyword value + * May 27 1998 Add BLSEARCH to find usable blank lines in header + * May 27 1998 Split off fitsio and imhio subroutines to fitsio.h + * May 27 1998 Add all subroutines in hget.c, hput.c, and iget.c to C++ dec. + * Jun 24 1998 Add string lengths to ra2str(), dec2str, and deg2str() calls + * Jun 25 1998 Fix other C++ declarations with added string lengths + * Aug 31 1998 Add current date subroutines getltime() and getutime() + * Oct 28 1998 Add missing hgetc() to non c++ declarations + * + * Oct 6 1999 Add gethlength() to return current size of header + * Oct 14 1999 All HPUT subroutines now return an error code, 0 if OK, else -1 + * Oct 15 1999 Add hputcom() declaration + * Oct 21 1999 Add hgetm() declaration + * + * Mar 22 2000 Add int to iget*() declarations + * Mar 27 2000 Add hputm() declaration + * + * Apr 3 2002 Add hgeti4c(), hgetr8c(), and hgetsc() + * Apr 8 2002 Include sys/types.h + * Aug 30 2002 Add strcsrch() and strncsrch() + * + * Sep 23 2003 Change mgets() to mgetstr() to avoid name collision at UCO Lick + * Oct 20 2003 Add numdec() to return the number of decimal places in a string + * + * Feb 26 2004 Add igetc(), formerly internal to iget.c + * Jul 1 2004 Add setheadshrink() for hdel() + * Aug 30 2004 Add numdec() to non-C++ declarations + * + * May 22 2006 Add setleaveblank() to leave blank line where keyword is deleted + * Jun 28 2006 Add strfix() to clean up characters in strings + * Nov 29 2006 Drop semicolon at end of C++ ifdef + * + * Jan 9 2007 Fix declarations so ANSI prototypes are not just for C++ + */ diff --git a/tksao/wcssubs/hget.c b/tksao/wcssubs/hget.c new file mode 100644 index 0000000..866bcec --- /dev/null +++ b/tksao/wcssubs/hget.c @@ -0,0 +1,1921 @@ +/*** File libwcs/hget.c + *** May 19, 2011 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1994-2011 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: hget.c (Get FITS Header parameter values) + * Purpose: Extract values for variables from FITS header string + * Subroutine: hgeti2 (hstring,keyword,ival) returns short integer + * Subroutine: hgeti4c (hstring,keyword,wchar,ival) returns long integer + * Subroutine: hgeti4 (hstring,keyword,ival) returns long integer + * Subroutine: hgetr4 (hstring,keyword,rval) returns real + * Subroutine: hgetra (hstring,keyword,ra) returns double RA in degrees + * Subroutine: hgetdec (hstring,keyword,dec) returns double Dec in degrees + * Subroutine: hgetr8c (hstring,keyword,wchar,dval) returns double + * Subroutine: hgetr8 (hstring,keyword,dval) returns double + * Subroutine: hgetl (hstring,keyword,lval) returns logical int (0=F, 1=T) + * Subroutine: hgetsc (hstring,keyword,wchar,lstr,str) returns character string + * Subroutine: hgets (hstring,keyword, lstr, str) returns character string + * Subroutine: hgetm (hstring,keyword, lstr, str) returns multi-keyword string + * Subroutine: hgetdate (hstring,keyword,date) returns date as fractional year + * Subroutine: hgetndec (hstring, keyword, ndec) returns number of dec. places + * Subroutine: hgetc (hstring,keyword) returns character string + * Subroutine: blsearch (hstring,keyword) returns pointer to blank lines + before keyword + * Subroutine: ksearch (hstring,keyword) returns pointer to header string entry + * Subroutine: str2ra (in) converts string to right ascension in degrees + * Subroutine: str2dec (in) converts string to declination in degrees + * Subroutine: strsrch (s1, s2) finds string s2 in null-terminated string s1 + * Subroutine: strnsrch (s1, s2, ls1) finds string s2 in ls1-byte string s1 + * Subroutine: hlength (header,lhead) sets length of FITS header for searching + * Subroutine: isnum (string) returns 1 if integer, 2 if fp number, else 0 + * Subroutine: notnum (string) returns 0 if number, else 1 + * Subroutine: numdec (string) returns number of decimal places in numeric string + * Subroutine: strfix (string,blankfill,zerodrop) removes extraneous characters + */ + +#include <string.h> /* NULL, strlen, strstr, strcpy */ +#include <stdio.h> +#include "fitshead.h" /* FITS header extraction subroutines */ +#include <stdlib.h> +#ifndef VMS +#include <limits.h> +#else +#define INT_MAX 2147483647 /* Biggest number that can fit in long */ +#define SHRT_MAX 32767 +#endif +#define VLENGTH 81 + +#ifdef USE_SAOLIB +static int use_saolib=0; +#endif + +char *hgetc (); + +static char val[VLENGTH+1]; +static int multiline = 0; + +static int lhead0 = 0; /* Length of header string */ + +/* Set the length of the header string, if not terminated by NULL */ +int +hlength (header, lhead) +const char *header; /* FITS header */ +int lhead; /* Maximum length of FITS header */ +{ + char *hend; + if (lhead > 0) + lhead0 = lhead; + else { + lhead0 = 0; + hend = ksearch (header,"END"); + lhead0 = hend + 80 - header; + } + return (lhead0); +} + +/* Return the length of the header string, computing it if lhead0 not set */ +int +gethlength (header) +char *header; /* FITS header */ +{ + if (lhead0 > 0) + return (lhead0); + else + return (hlength (header, 0)); +} + + +/* Extract Integer*4 value for variable from FITS header string */ + +int +hgeti4c (hstring,keyword,wchar,ival) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for + a line beginning with this string. if "[n]" is + present, the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const char *wchar; /* Character of multiple WCS header; =0 if unused */ +int *ival; /* Keyword value returned */ +{ + char keyword1[16]; + int lkey; + + if (wchar[0] < (char) 64) + return (hgeti4 (hstring, keyword, ival)); + else { + strcpy (keyword1, keyword); + lkey = strlen (keyword); + keyword1[lkey] = wchar[0]; + keyword1[lkey+1] = (char) 0; + return (hgeti4 (hstring, keyword1, ival)); + } +} + + +/* Extract long value for variable from FITS header string */ + +int +hgeti4 (hstring,keyword,ival) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int *ival; +{ + char *value; + double dval; + int minint; + int lval; + char *dchar; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII to binary */ + if (value != NULL) { + if (value[0] == '#') value++; + minint = -INT_MAX - 1; + lval = strlen (value); + if (lval > VLENGTH) { + strncpy (val, value, VLENGTH); + val[VLENGTH] = (char) 0; + } + else + strcpy (val, value); + if (isnum (val) == 2) { + if ((dchar = strchr (val, 'D'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'd'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'E'))) + *dchar = 'e'; + } + dval = atof (val); + if (dval+0.001 > INT_MAX) + *ival = INT_MAX; + else if (dval >= 0) + *ival = (int) (dval + 0.001); + else if (dval-0.001 < minint) + *ival = minint; + else + *ival = (int) (dval - 0.001); + return (1); + } + else { + return (0); + } +} + + +/* Extract integer*2 value for variable from fits header string */ + +int +hgeti2 (hstring,keyword,ival) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +short *ival; +{ + char *value; + double dval; + int minshort; + int lval; + char *dchar; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII to binary */ + if (value != NULL) { + if (value[0] == '#') value++; + lval = strlen (value); + if (lval > VLENGTH) { + strncpy (val, value, VLENGTH); + val[VLENGTH] = (char) 0; + } + else + strcpy (val, value); + if (isnum (val) == 2) { + if ((dchar = strchr (val, 'D'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'd'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'E'))) + *dchar = 'e'; + } + dval = atof (val); + minshort = -SHRT_MAX - 1; + if (dval+0.001 > SHRT_MAX) + *ival = SHRT_MAX; + else if (dval >= 0) + *ival = (short) (dval + 0.001); + else if (dval-0.001 < minshort) + *ival = minshort; + else + *ival = (short) (dval - 0.001); + return (1); + } + else { + return (0); + } +} + +/* Extract real value for variable from FITS header string */ + +int +hgetr4 (hstring,keyword,rval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +float *rval; +{ + char *value; + int lval; + char *dchar; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* translate value from ASCII to binary */ + if (value != NULL) { + if (value[0] == '#') value++; + lval = strlen (value); + if (lval > VLENGTH) { + strncpy (val, value, VLENGTH); + val[VLENGTH] = (char) 0; + } + else + strcpy (val, value); + if (isnum (val) == 2) { + if ((dchar = strchr (val, 'D'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'd'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'E'))) + *dchar = 'e'; + } + *rval = (float) atof (val); + return (1); + } + else { + return (0); + } +} + + +/* Extract real*8 right ascension in degrees from FITS header string */ + +int +hgetra (hstring,keyword,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +double *dval; /* Right ascension in degrees (returned) */ +{ + char *value; + + /* Get value from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII colon-delimited string to binary */ + if (value != NULL) { + *dval = str2ra (value); + return (1); + } + else + return (0); +} + + +/* Extract real*8 declination in degrees from FITS header string */ + +int +hgetdec (hstring,keyword,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +double *dval; /* Right ascension in degrees (returned) */ +{ + char *value; + + /* Get value from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII colon-delimited string to binary */ + if (value != NULL) { + *dval = str2dec (value); + return (1); + } + else + return (0); +} + + +/* Extract real*8 value for variable from FITS header string */ + +int +hgetr8c (hstring,keyword,wchar,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for + a line beginning with this string. if "[n]" is + present, the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const char *wchar; /* Character of multiple WCS header; =0 if unused */ +double *dval; /* Keyword value returned */ +{ + char keyword1[16]; + int lkey; + + if (wchar[0] < (char) 64) + return (hgetr8 (hstring, keyword, dval)); + else { + strcpy (keyword1, keyword); + lkey = strlen (keyword); + keyword1[lkey] = wchar[0]; + keyword1[lkey+1] = (char) 0; + return (hgetr8 (hstring, keyword1, dval)); + } +} + + + +/* Extract real*8 value for variable from FITS header string */ + +int +hgetr8 (hstring,keyword,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +double *dval; +{ + char *value; + int lval; + char *dchar; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII to binary */ + if (value != NULL) { + if (value[0] == '#') value++; + lval = strlen (value); + if (lval > VLENGTH) { + strncpy (val, value, VLENGTH); + val[VLENGTH] = (char) 0; + } + else + strcpy (val, value); + if (isnum (val) == 2) { + if ((dchar = strchr (val, 'D'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'd'))) + *dchar = 'e'; + if ((dchar = strchr (val, 'E'))) + *dchar = 'e'; + } + *dval = atof (val); + return (1); + } + else { + return (0); + } +} + + +/* Extract logical value for variable from FITS header string */ + +int +hgetl (hstring,keyword,ival) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int *ival; +{ + char *value; + char newval; + int lval; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII to binary */ + if (value != NULL) { + lval = strlen (value); + if (lval > VLENGTH) { + strncpy (val, value, VLENGTH); + val[VLENGTH] = (char) 0; + } + else + strcpy (val, value); + newval = val[0]; + if (newval == 't' || newval == 'T') + *ival = 1; + else + *ival = 0; + return (1); + } + else { + return (0); + } +} + + +/* Extract real*8 date from FITS header string (dd/mm/yy or dd-mm-yy) */ + +int +hgetdate (hstring,keyword,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +double *dval; +{ + double yeardays, seconds, fday; + char *value,*sstr, *dstr, *tstr, *cstr, *nval; + int year, month, day, yday, i, hours, minutes; + static int mday[12] = {31,28,31,30,31,30,31,31,30,31,30,31}; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Translate value from ASCII to binary */ + if (value != NULL) { + sstr = strchr (value,'/'); + dstr = strchr (value,'-'); + + /* Original FITS date format: dd/mm/yy */ + if (sstr > value) { + *sstr = '\0'; + day = (int) atof (value); + *sstr = '/'; + nval = sstr + 1; + sstr = strchr (nval,'/'); + if (sstr == NULL) + sstr = strchr (nval,'-'); + if (sstr > value) { + *sstr = '\0'; + month = (int) atof (nval); + *sstr = '/'; + nval = sstr + 1; + year = (int) atof (nval); + if (day > 31) { + yday = year; + year = day; + day = yday; + } + if (year >= 0 && year <= 49) + year = year + 2000; + else if (year < 100) + year = year + 1900; + if ((year % 4) == 0) + mday[1] = 29; + else + mday[1] = 28; + if ((year % 100) == 0 && (year % 400) != 0) + mday[1] = 28; + if (day > mday[month-1]) + day = mday[month-1]; + else if (day < 1) + day = 1; + if (mday[1] == 28) + yeardays = 365.0; + else + yeardays = 366.0; + yday = day - 1; + for (i = 0; i < month-1; i++) + yday = yday + mday[i]; + *dval = (double) year + ((double)yday / yeardays); + return (1); + } + else + return (0); + } + + /* New FITS date format: yyyy-mm-ddThh:mm:ss[.sss] */ + else if (dstr > value) { + *dstr = '\0'; + year = (int) atof (value); + *dstr = '-'; + nval = dstr + 1; + dstr = strchr (nval,'-'); + month = 1; + day = 1; + tstr = NULL; + if (dstr > value) { + *dstr = '\0'; + month = (int) atof (nval); + *dstr = '-'; + nval = dstr + 1; + tstr = strchr (nval,'T'); + if (tstr > value) + *tstr = '\0'; + day = (int) atof (nval); + if (tstr > value) + *tstr = 'T'; + } + + /* If year is < 32, it is really day of month in old format */ + if (year < 32) { + i = year; + year = day + 1900; + day = i; + } + + if ((year % 4) == 0) + mday[1] = 29; + else + mday[1] = 28; + if ((year % 100) == 0 && (year % 400) != 0) + mday[1] = 28; + if (day > mday[month-1]) + day = mday[month-1]; + else if (day < 1) + day = 1; + if (mday[1] == 28) + yeardays = 365.0; + else + yeardays = 366.0; + yday = day - 1; + for (i = 0; i < month-1; i++) + yday = yday + mday[i]; + *dval = (double) year + ((double)yday / yeardays); + + /* Extract time, if it is present */ + if (tstr > value) { + nval = tstr + 1; + hours = 0.0; + minutes = 0.0; + seconds = 0.0; + cstr = strchr (nval,':'); + if (cstr > value) { + *cstr = '\0'; + hours = (int) atof (nval); + *cstr = ':'; + nval = cstr + 1; + cstr = strchr (nval,':'); + if (cstr > value) { + *cstr = '\0'; + minutes = (int) atof (nval); + *cstr = ':'; + nval = cstr + 1; + seconds = atof (nval); + } + else { + minutes = (int) atof (nval); + seconds = 0.0; + } + } + fday = ((3.6e3 * (double)hours) + (6.e1 * (double)minutes) + + seconds) / 8.64e4; + *dval = *dval + (fday / yeardays); + } + return (1); + } + else + return (0); + } + else + return (0); +} + + +/* Extract IRAF multiple-keyword string value from FITS header string */ + +int +hgetm (hstring, keyword, lstr, str) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the root name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char *value; + char *stri; + char keywordi[16]; + int lval, lstri, ikey; + char keyform[8]; + + stri = str; + lstri = lstr; + + sprintf (keywordi, "%s_1", keyword); + if (ksearch (hstring, keywordi)) + strcpy (keyform, "%s_%d"); + else { + sprintf (keywordi, "%s_01", keyword); + if (ksearch (hstring, keywordi)) + strcpy (keyform, "%s_%02d"); + else { + sprintf (keywordi, "%s_001", keyword); + if (ksearch (hstring, keywordi)) + strcpy (keyform, "%s_%03d"); + else if (ksearch (hstring, keywordi)) + strcpy (keyform, "%s_%03d"); + else + return (0); + } + } + + /* Loop through sequentially-named keywords */ + multiline = 1; + for (ikey = 1; ikey < 500; ikey++) { + sprintf (keywordi, keyform, keyword, ikey); + + /* Get value for this keyword */ + value = hgetc (hstring, keywordi); + if (value != NULL) { + lval = strlen (value); + if (lval < lstri) + strcpy (stri, value); + else if (lstri > 1) { + strncpy (stri, value, lstri-1); + stri[lstri] = (char) 0; + break; + } + else { + str[0] = value[0]; + break; + } + } + else + break; + stri = stri + lval; + lstri = lstri - lval; + } + multiline = 0; + + /* Return 1 if any keyword found, else 0 */ + if (ikey > 1) + return (1); + else + return (0); +} + + +/* Extract string value for variable from FITS header string */ + +int +hgetsc (hstring,keyword,wchar,lstr,str) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for + a line beginning with this string. if "[n]" is + present, the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const char *wchar; /* Character of multiple WCS header; =0 if unused */ +const int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char keyword1[16]; + int lkey; + + if (wchar[0] < (char) 64) + return (hgets (hstring, keyword, lstr, str)); + else { + strcpy (keyword1, keyword); + lkey = strlen (keyword); + keyword1[lkey] = wchar[0]; + keyword1[lkey+1] = (char) 0; + return (hgets (hstring, keyword1, lstr, str)); + } +} + + +/* Extract string value for variable from FITS header string */ + +int +hgets (hstring, keyword, lstr, str) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char *value; + int lval; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + if (value != NULL) { + lval = strlen (value); + if (lval < lstr) + strcpy (str, value); + else if (lstr > 1) + strncpy (str, value, lstr-1); + else + str[0] = value[0]; + return (1); + } + else + return (0); +} + + +/* Extract number of decimal places for value in FITS header string */ + +int +hgetndec (hstring, keyword, ndec) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int *ndec; /* Number of decimal places in keyword value */ +{ + char *value; + int i, nchar; + + /* Get value and comment from header string */ + value = hgetc (hstring,keyword); + + /* Find end of string and count backward to decimal point */ + *ndec = 0; + if (value != NULL) { + nchar = strlen (value); + for (i = nchar-1; i >= 0; i--) { + if (value[i] == '.') + return (1); + *ndec = *ndec + 1; + } + return (1); + } + else + return (0); +} + + +/* Extract character value for variable from FITS header string */ + +char * +hgetc (hstring,keyword0) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword0; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +{ + static char cval[80]; + char *value; + char cwhite[2]; + char squot[2], dquot[2], lbracket[2], rbracket[2], slash[2], comma[2]; + char space; + char keyword[81]; /* large for ESO hierarchical keywords */ + char line[100]; + char *vpos, *cpar; + char *q1, *q2, *v1, *v2, *c1, *brack1, *brack2; + int ipar, i, lkey; + +#ifdef USE_SAOLIB + int iel=1, ip=1, nel, np, ier; + char *get_fits_head_str(); + + if( !use_saolib ){ +#endif + + squot[0] = (char) 39; + squot[1] = (char) 0; + dquot[0] = (char) 34; + dquot[1] = (char) 0; + lbracket[0] = (char) 91; + lbracket[1] = (char) 0; + comma[0] = (char) 44; + comma[1] = (char) 0; + rbracket[0] = (char) 93; + rbracket[1] = (char) 0; + slash[0] = (char) 47; + slash[1] = (char) 0; + space = (char) 32; + + /* Find length of variable name */ + strncpy (keyword,keyword0, sizeof(keyword)-1); + brack1 = strsrch (keyword,lbracket); + if (brack1 == NULL) + brack1 = strsrch (keyword,comma); + if (brack1 != NULL) { + *brack1 = '\0'; + brack1++; + } + + /* Search header string for variable name */ + vpos = ksearch (hstring,keyword); + + /* Exit if not found */ + if (vpos == NULL) + return (NULL); + + /* Initialize line to nulls */ + for (i = 0; i < 100; i++) + line[i] = 0; + +/* In standard FITS, data lasts until 80th character */ + + /* Extract entry for this variable from the header */ + strncpy (line,vpos,80); + + /* Check for quoted value */ + q1 = strsrch (line,squot); + c1 = strsrch (line,slash); + if (q1 != NULL) { + if (c1 != NULL && q1 < c1) { + q2 = strsrch (q1+1,squot); + if (q2 == NULL) { + q2 = c1 - 1; + while (*q2 == space) + q2--; + q2++; + } + else if (c1 < q2) + c1 = strsrch (q2,slash); + } + else if (c1 == NULL) { + q2 = strsrch (q1+1,squot); + if (q2 == NULL) { + q2 = line + 79; + while (*q2 == space) + q2--; + q2++; + } + } + else + q1 = NULL; + } + else { + q1 = strsrch (line,dquot); + if (q1 != NULL) { + if (c1 != NULL && q1 < c1) { + q2 = strsrch (q1+1,dquot); + if (q2 == NULL) { + q2 = c1 - 1; + while (*q2 == space) + q2--; + q2++; + } + else if (c1 < q2) + c1 = strsrch (q2,slash); + } + else if (c1 == NULL) { + q2 = strsrch (q1+1,dquot); + if (q2 == NULL) { + q2 = line + 79; + while (*q2 == space) + q2--; + q2++; + } + } + else + q1 = NULL; + } + else { + q1 = NULL; + q2 = line + 10; + } + } + + /* Extract value and remove excess spaces */ + if (q1 != NULL) { + v1 = q1 + 1; + v2 = q2; + } + else { + v1 = strsrch (line,"="); + if (v1 == NULL) + v1 = line + 9; + else + v1 = v1 + 1; + c1 = strsrch (line,"/"); + if (c1 != NULL) + v2 = c1; + else + v2 = line + 79; + } + + /* Ignore leading spaces if not multiline */ + if (!multiline) { + while (*v1 == ' ' && v1 < v2) { + v1++; + } + } + + /* Drop trailing spaces */ + *v2 = '\0'; + if (!multiline) { + v2--; + while ((*v2 == ' ' || *v2 == (char) 13) && v2 > v1) { + *v2 = '\0'; + v2--; + } + } + + /* Convert -zero to just plain 0 */ + if (!strcmp (v1, "-0")) + v1++; + strcpy (cval,v1); + value = cval; + + /* If keyword has brackets, extract appropriate token from value */ + if (brack1 != NULL) { + brack2 = strsrch (brack1,rbracket); + if (brack2 != NULL) + *brack2 = '\0'; + if (isnum (brack1)) { + ipar = atoi (brack1); + cwhite[0] = ' '; + cwhite[1] = '\0'; + if (ipar > 0) { + for (i = 1; i <= ipar; i++) { + cpar = strtok (v1,cwhite); + v1 = NULL; + } + if (cpar != NULL) { + strcpy (cval,cpar); + value = cval; + } + else + value = NULL; + } + + /* If token counter is negative, include rest of value */ + else if (ipar < 0) { + for (i = 1; i < -ipar; i++) { + v1 = strchr (v1, ' '); + if (v1 == NULL) + break; + else + v1 = v1 + 1; + } + if (v1 != NULL) { + strcpy (cval, v1); + value = cval; + } + else + value = NULL; + } + } + else { + lkey = strlen (brack1); + for (i = 0; i < lkey; i++) { + if (brack1[i] > 64 && brack1[i] < 91) + brack1[i] = brack1[i] + 32; + } + v1 = igetc (cval, brack1); + if (v1) { + strcpy (cval,v1); + value = cval; + } + else + value = NULL; + } + } + + return (value); +#ifdef USE_SAOLIB + } else { + return(get_fits_head_str(keyword0, iel, ip, &nel, &np, &ier, hstring)); + } +#endif +} + + +/* Find beginning of fillable blank line before FITS header keyword line */ + +char * +blsearch (hstring,keyword) + +/* Find entry for keyword keyword in FITS header string hstring. + (the keyword may have a maximum of eight letters) + NULL is returned if the keyword is not found */ + +const char *hstring; /* character string containing fits-style header + information in the format <keyword>= <value> {/ <comment>} + the default is that each entry is 80 characters long; + however, lines may be of arbitrary length terminated by + nulls, carriage returns or linefeeds, if packed is true. */ +const char *keyword; /* character string containing the name of the variable + to be returned. ksearch searches for a line beginning + with this string. The string may be a character + literal or a character variable terminated by a null + or '$'. it is truncated to 8 characters. */ +{ + const char *headlast; + char *loc, *headnext, *pval, *lc, *line; + char *bval; + int icol, nextchar, lkey, nleft, lhstr; + + pval = 0; + + /* Search header string for variable name */ + if (lhead0) + lhstr = lhead0; + else { + lhstr = 0; + while (lhstr < 256000 && hstring[lhstr] != 0) + lhstr++; + } + headlast = hstring + lhstr; + headnext = (char *) hstring; + pval = NULL; + while (headnext < headlast) { + nleft = headlast - headnext; + loc = strncsrch (headnext, keyword, nleft); + + /* Exit if keyword is not found */ + if (loc == NULL) { + break; + } + + icol = (loc - hstring) % 80; + lkey = strlen (keyword); + nextchar = (int) *(loc + lkey); + + /* If this is not in the first 8 characters of a line, keep searching */ + if (icol > 7) + headnext = loc + 1; + + /* If parameter name in header is longer, keep searching */ + else if (nextchar != 61 && nextchar > 32 && nextchar < 127) + headnext = loc + 1; + + /* If preceeding characters in line are not blanks, keep searching */ + else { + line = loc - icol; + for (lc = line; lc < loc; lc++) { + if (*lc != ' ') + headnext = loc + 1; + } + + /* Return pointer to start of line if match */ + if (loc >= headnext) { + pval = line; + break; + } + } + } + + /* Return NULL to calling program if keyword is not found */ + if (pval == NULL) + return (pval); + + /* Return NULL if keyword is found at start of FITS header string */ + if (pval == hstring) + return (NULL); + + /* Find last nonblank in FITS header string line before requested keyword */ + bval = pval - 80; + while (!strncmp (bval," ",8) && bval >= hstring) + bval = bval - 80; + bval = bval + 80; + + /* Return pointer to calling program if blank lines found */ + if (bval < pval && bval >= hstring) + return (bval); + else + return (NULL); +} + + +/* Find FITS header line containing specified keyword */ + +/*** waj ***/ +extern char* findit(char*,char*); +char* ksearch(const char* hstring, const char* keyword) +{ + return findit((char*)hstring, (char*)keyword); +} + +char * +ksearchh (hstring,keyword) +/*** waj ***/ + +/* Find entry for keyword keyword in FITS header string hstring. + (the keyword may have a maximum of eight letters) + NULL is returned if the keyword is not found */ + +const char *hstring; /* character string containing fits-style header + information in the format <keyword>= <value> {/ <comment>} + the default is that each entry is 80 characters long; + however, lines may be of arbitrary length terminated by + nulls, carriage returns or linefeeds, if packed is true. */ +const char *keyword; /* character string containing the name of the variable + to be returned. ksearch searches for a line beginning + with this string. The string may be a character + literal or a character variable terminated by a null + or '$'. it is truncated to 8 characters. */ +{ + const char *headlast; + char *loc, *headnext, *pval, *lc, *line; + int icol, nextchar, lkey, nleft, lhead, lmax; + +#ifdef USE_SAOLIB + int iel=1, ip=1, nel, np, ier; + char *get_fits_head_str(); + + if( !use_saolib ){ +#endif + + pval = 0; + +/* Find current length of header string */ + if (lhead0) + lmax = lhead0; + else + lmax = 256000; + for (lhead = 0; lhead < lmax; lhead++) { + if (hstring[lhead] <= (char) 0) + break; + } + +/* Search header string for variable name */ + headlast = hstring + lhead; + headnext = (char *) hstring; + pval = NULL; + while (headnext < headlast) { + nleft = headlast - headnext; + loc = strncsrch (headnext, keyword, nleft); + + /* Exit if keyword is not found */ + if (loc == NULL) { + break; + } + + icol = (loc - hstring) % 80; + lkey = strlen (keyword); + nextchar = (int) *(loc + lkey); + + /* If this is not in the first 8 characters of a line, keep searching */ + if (icol > 7) + headnext = loc + 1; + + /* If parameter name in header is longer, keep searching */ + else if (nextchar != 61 && nextchar > 32 && nextchar < 127) + headnext = loc + 1; + + /* If preceeding characters in line are not blanks, keep searching */ + else { + line = loc - icol; + for (lc = line; lc < loc; lc++) { + if (*lc != ' ') + headnext = loc + 1; + } + + /* Return pointer to start of line if match */ + if (loc >= headnext) { + pval = line; + break; + } + } + } + +/* Return pointer to calling program */ + return (pval); + +#ifdef USE_SAOLIB + } + else { + if (get_fits_head_str(keyword,iel,ip,&nel,&np,&ier,hstring) != NULL) + return(hstring); + else + return(NULL); + } +#endif +} + + +/* Return the right ascension in degrees from sexagesimal hours or decimal degrees */ + +double +str2ra (in) + +const char *in; /* Character string of sexigesimal hours or decimal degrees */ + +{ + double ra; /* Right ascension in degrees (returned) */ + + ra = str2dec (in); + if (strsrch (in,":")) + ra = ra * 15.0; + + return (ra); +} + + +/* Return the declination in degrees from sexagesimal or decimal degrees */ + +double +str2dec (in) + +const char *in; /* Character string of sexigesimal or decimal degrees */ + +{ + double dec; /* Declination in degrees (returned) */ + double deg, min, sec, sign; + char *value, *c1, *c2; + int lval; + char *dchar; + + dec = 0.0; + + /* Return 0.0 if string is null */ + if (in == NULL) + return (dec); + + /* Translate value from ASCII colon-delimited string to binary */ + if (in[0]) { + value = (char *) in; + + /* Remove leading spaces */ + while (*value == ' ') + value++; + + /* Save sign */ + if (*value == '-') { + sign = -1.0; + value++; + } + else if (*value == '+') { + sign = 1.0; + value++; + } + else + sign = 1.0; + + /* Turn comma into space */ + if ((c1 = strsrch (value,",")) != NULL) + *c1 = ' '; + + /* Remove trailing spaces */ + lval = strlen (value); + while (value[lval-1] == ' ') + lval--; + + if ((c1 = strsrch (value,":")) == NULL) + c1 = strnsrch (value," ",lval); + if (c1 != NULL) { + *c1 = 0; + deg = (double) atoi (value); + *c1 = ':'; + value = c1 + 1; + if ((c2 = strsrch (value,":")) == NULL) + c2 = strsrch (value," "); + if (c2 != NULL) { + *c2 = 0; + min = (double) atoi (value); + *c2 = ':'; + value = c2 + 1; + sec = atof (value); + } + else { + sec = 0.0; + if ((c1 = strsrch (value,".")) != NULL) + min = atof (value); + if (strlen (value) > 0) + min = (double) atoi (value); + } + dec = sign * (deg + (min / 60.0) + (sec / 3600.0)); + } + else if (isnum (value) == 2) { + if ((dchar = strchr (value, 'D'))) + *dchar = 'e'; + if ((dchar = strchr (value, 'd'))) + *dchar = 'e'; + if ((dchar = strchr (value, 'E'))) + *dchar = 'e'; + dec = sign * atof (value); + } + else + dec = sign * (double) atoi (value); + } + return (dec); +} + + +/* Find string s2 within null-terminated string s1 */ + +char * +strsrch (s1, s2) + +const char *s1; /* String to search */ +const char *s2; /* String to look for */ + +{ + int ls1; + ls1 = strlen (s1); + return (strnsrch (s1, s2, ls1)); +} + + +/* Find string s2 within string s1 */ + +char * +strnsrch (s1, s2, ls1) + +const char *s1; /* String to search */ +const char *s2; /* String to look for */ +const int ls1; /* Length of string being searched */ + +{ + char *s,*s1e; + char cfirst,clast; + int i,ls2; + + /* Return null string if either pointer is NULL */ + if (s1 == NULL || s2 == NULL) + return (NULL); + + /* A zero-length pattern is found in any string */ + ls2 = strlen (s2); + if (ls2 ==0) + return ((char *) s1); + + /* Only a zero-length string can be found in a zero-length string */ + if (ls1 ==0) + return (NULL); + + cfirst = (char) s2[0]; + clast = (char) s2[ls2-1]; + s1e = (char *) s1 + (int) ls1 - ls2 + 1; + s = (char *) s1; + while (s < s1e) { + + /* Search for first character in pattern string */ + if (*s == cfirst) { + + /* If single character search, return */ + if (ls2 == 1) + return (s); + + /* Search for last character in pattern string if first found */ + if (s[ls2-1] == clast) { + + /* If two-character search, return */ + if (ls2 == 2) + return (s); + + /* If 3 or more characters, check for rest of search string */ + i = 1; + while (i < ls2 && s[i] == s2[i]) + i++; + + /* If entire string matches, return */ + if (i >= ls2) + return (s); + } + } + s++; + } + return (NULL); +} + + +/* Find string s2 within null-terminated string s1 (case-free search) */ + +char * +strcsrch (s1, s2) + +const char *s1; /* String to search */ +const char *s2; /* String to look for */ + +{ + int ls1; + ls1 = strlen ((char *) s1); + return (strncsrch (s1, s2, ls1)); +} + + +/* Find string s2 within string s1 (case-free search) */ + +char * +strncsrch (s1, s2, ls1) + +const char *s1; /* String to search */ +const char *s2; /* String to look for */ +const int ls1; /* Length of string being searched */ + +{ + char *s,*s1e, sl, *os2; + char cfirst,ocfirst; + char clast = ' '; + char oclast = ' '; + int i,ls2; + + /* Return null string if either pointer is NULL */ + if (s1 == NULL || s2 == NULL) + return (NULL); + + /* A zero-length pattern is found in any string */ + ls2 = strlen (s2); + if (ls2 ==0) + return ((char *) s1); + + /* Only a zero-length string can be found in a zero-length string */ + os2 = NULL; + if (ls1 ==0) + return (NULL); + + /* For one or two characters, set opposite case first and last letters */ + if (ls2 < 3) { + cfirst = (char) s2[0]; + if (cfirst > 96 && cfirst < 123) + ocfirst = cfirst - 32; + else if (cfirst > 64 && cfirst < 91) + ocfirst = cfirst + 32; + else + ocfirst = cfirst; + if (ls2 > 1) { + clast = s2[1]; + if (clast > 96 && clast < 123) + oclast = clast - 32; + else if (clast > 64 && clast < 91) + oclast = clast + 32; + else + oclast = clast; + } + } + + /* Else duplicate string with opposite case letters for comparison */ + else { + os2 = (char *) calloc (ls2, 1); + for (i = 0; i < ls2; i++) { + if (s2[i] > 96 && s2[i] < 123) + os2[i] = s2[i] - 32; + else if (s2[i] > 64 && s2[i] < 91) + os2[i] = s2[i] + 32; + else + os2[i] = s2[i]; + } + cfirst = s2[0]; + ocfirst = os2[0]; + clast = s2[ls2-1]; + oclast = os2[ls2-1]; + } + + /* Loop through input string, character by character */ + s = (char *) s1; + s1e = s + (int) ls1 - ls2 + 1; + while (s < s1e) { + + /* Search for first character in pattern string */ + if (*s == cfirst || *s == ocfirst) { + + /* If single character search, return */ + if (ls2 == 1) { + if (os2 != NULL) + free (os2); + return (s); + } + + /* Search for last character in pattern string if first found */ + sl = s[ls2-1]; + if (sl == clast || sl == oclast) { + + /* If two-character search, return */ + if (ls2 == 2) { + if (os2 != NULL) + free (os2); + return (s); + } + + /* If 3 or more characters, check for rest of search string */ + i = 1; + while (i < ls2 && (s[i] == (char) s2[i] || s[i] == os2[i])) + i++; + + /* If entire string matches, return */ + if (i >= ls2) { + if (os2 != NULL) + free (os2); + return (s); + } + } + } + s++; + } + if (os2 != NULL) + free (os2); + return (NULL); +} + + +int +notnum (string) + +const char *string; /* Character string */ +{ + if (isnum (string)) + return (0); + else + return (1); +} + + +/* ISNUM-- Return 1 if string is an integer number, + 2 if floating point, + 3 if sexigesimal, with or without decimal point + else 0 + */ + +int +isnum (string) + +const char *string; /* Character string */ +{ + int lstr, i, nd, cl; + char cstr, cstr1; + int fpcode; + + /* Return 0 if string is NULL */ + if (string == NULL) + return (0); + + lstr = strlen (string); + nd = 0; + cl = 0; + fpcode = 1; + + /* Return 0 if string starts with a D or E */ + cstr = string[0]; + if (cstr == 'D' || cstr == 'd' || + cstr == 'E' || cstr == 'e') { + return (0); + } + + /* Remove trailing spaces */ + while (string[lstr-1] == ' ') + lstr--; + + /* Numeric strings contain 0123456789-+ and d or e for exponents */ + for (i = 0; i < lstr; i++) { + cstr = string[i]; + if (cstr == '\n') + break; + + /* Ignore leading spaces */ + if (cstr == ' ' && nd == 0) + continue; + + if ((cstr < 48 || cstr > 57) && + cstr != '+' && cstr != '-' && + cstr != 'D' && cstr != 'd' && + cstr != 'E' && cstr != 'e' && + cstr != ':' && cstr != '.') + return (0); + else if (cstr == '+' || cstr == '-') { + if (string[i+1] == '-' || string[i+1] == '+') + return (0); + else if (i > 0) { + cstr1 = string[i-1]; + if (cstr1 != 'D' && cstr1 != 'd' && + cstr1 != 'E' && cstr1 != 'e' && + cstr1 != ':' && cstr1 != ' ') + return (0); + } + } + else if (cstr >= 47 && cstr <= 57) + nd++; + + /* Check for colon */ + else if (cstr == 58) + cl++; + if (cstr=='.' || cstr=='d' || cstr=='e' || cstr=='d' || cstr=='e') + fpcode = 2; + } + if (nd > 0) { + if (cl) + fpcode = 3; + return (fpcode); + } + else + return (0); +} + + +/* NUMDEC -- Return number of decimal places in numeric string (-1 if not number) */ + +int +numdec (string) + +const char *string; /* Numeric string */ +{ + char *cdot; + int lstr; + + if (notnum (string) && !strchr (string, ':')) + return (-1); + else { + lstr = strlen (string); + if ((cdot = strchr (string, '.')) == NULL) + return (0); + else + return (lstr - (cdot - string) - 1); + } +} + + +#ifdef USE_SAOLIB +int set_saolib(hstring) + void *hstring; +{ + if( *((int *)hstring) == 142857 ) + use_saolib = 1; + else + use_saolib = 0; +} + +#endif + + +/* Remove exponent, leading #, surrounding parentheses, + and/or trailing zeroes, if reasonable */ +void +strfix (string, fillblank, dropzero) + +char *string; /* String to modify */ +int fillblank; /* If nonzero, fill blanks with underscores */ +int dropzero; /* If nonzero, drop trailing zeroes */ +{ + char *sdot, *s, *strend, *str, ctemp, *slast; + int ndek, lstr, i; + + /* If number, ignore leading # and remove trailing non-numeric character */ + if (string[0] == '#') { + strend = string + strlen (string); + str = string + 1; + strend = str + strlen (str) - 1; + ctemp = *strend; + if (!isnum (strend)) + *strend = (char) 0; + if (isnum (str)) { + strend = string + strlen (string); + for (str = string; str < strend; str++) + *str = *(str + 1); + } + else + *strend = ctemp; + } + + /* Remove parentheses if they enclose the string */ + if (string[0] == '(') { + lstr = strlen (string); + if (string[lstr-1] == ')') { + string[lstr-1] = (char) 0; + strend = string + lstr - 1; + for (str = string; str < strend; str++) + *str = *(str+1); + string[lstr-2] = (char) 0; + } + } + + /* Remove positive exponent if there are enough digits given */ + if (isnum (string) > 1 && strsrch (string, "E+") != NULL) { + lstr = strlen (string); + ndek = (int) (string[lstr-1] - 48); + ndek = ndek + (10 * ((int) (string[lstr-2] - 48))); + if (ndek < lstr - 7) { + lstr = lstr - 4; + string[lstr] = (char) 0; + string[lstr+1] = (char) 0; + string[lstr+2] = (char) 0; + string[lstr+3] = (char) 0; + sdot = strchr (string, '.'); + if (ndek > 0 && sdot != NULL) { + for (i = 1; i <= ndek; i++) { + *sdot = *(sdot+1); + sdot++; + *sdot = '.'; + } + } + } + } + + /* Remove trailing zeroes if they are not significant */ + if (dropzero) { + if (isnum (string) > 1 && strchr (string, '.') != NULL && + strsrch (string, "E-") == NULL && + strsrch (string, "E+") == NULL && + strsrch (string, "e-") == NULL && + strsrch (string, "e+") == NULL) { + lstr = strlen (string); + s = string + lstr - 1; + while (*s == '0' && lstr > 1) { + if (*(s - 1) != '.') { + *s = (char) 0; + lstr --; + } + s--; + } + } + } + + /* Remove trailing decimal point */ + lstr = strlen (string); + s = string + lstr - 1; + if (*s == '.') + *s = (char) 0; + + /* Replace embedded blanks with underscores, if requested to */ + if (fillblank) { + lstr = strlen (string); + slast = string + lstr; + for (s = string; s < slast; s++) { + if (*s == ' ') *s = '_'; + } + } + + return; + +} + +/* Oct 28 1994 New program + * + * Mar 1 1995 Search for / after second quote, not first one + * May 2 1995 Initialize line in HGETC; deal with logicals in HGETL better + * May 4 1995 Declare STRSRCH in KSEARCH + * Aug 7 1995 Fix line initialization in HGETC + * Dec 22 1995 Add HGETRA and HGETDEC to get degrees from xx:xx:xx.xxx string + * + * Jan 26 1996 Fix HGETL to not crash when parameter is not present + * Feb 1 1996 Fix HGETC to deal with quotes correctly + * Feb 1 1996 Fix HGETDEG to deal with sign correctly + * Feb 6 1996 Add HGETS to update character strings + * Feb 8 1996 Fix STRSRCH to find final characters in string + * Feb 23 1996 Add string to degree conversions + * Apr 26 1996 Add HGETDATE to get fractional year from date string + * May 22 1996 Fix documentation; return double from STR2RA and STR2DEC + * May 28 1996 Fix string translation of RA and Dec when no seconds + * Jun 10 1996 Remove unused variables after running lint + * Jun 17 1996 Fix bug which failed to return single character strings + * Jul 1 1996 Skip sign when reading declination after testing for it + * Jul 19 1996 Do not divide by 15 if RA header value is already in degrees + * Aug 5 1996 Add STRNSRCH to search strings which are not null-terminated + * Aug 6 1996 Make minor changes after lint + * Aug 8 1996 Fix ksearch bug which finds wrong keywords + * Aug 13 1996 Fix sign bug in STR2DEC for degrees + * Aug 26 1996 Drop unused variables ICOL0, NLINE, PREVCHAR from KSEARCH + * Sep 10 1996 Fix header length setting code + * Oct 15 1996 Clean up loops and fix ICOL assignment + * Nov 13 1996 Handle integer degrees correctly in STR2DEC + * Nov 21 1996 Make changes for Linux thanks to Sidik Isani + * Dec 12 1996 Add ISNUM to check to see whether strings are numbers + * + * Jan 22 1997 Add ifdefs for Eric Mandel (SAOtng) + * Jan 27 1997 Convert to integer through ATOF so exponents are recognized + * Jul 25 1997 Implement FITS version of ISO date format + * + * Feb 24 1998 Implement code to return IRAF multiple-keyword strings + * Mar 12 1998 Add subroutine NOTNUM + * Mar 27 1998 Add changes to match SKYCAT version + * Apr 30 1998 Add BLSEARCH() to find blank lines before END + * May 27 1998 Add HGETNDEC() to get number of decimal places in entry + * Jun 1 1998 Add VMS patch from Harry Payne at StSci + * Jun 18 1998 Fix code which extracts tokens from string values + * Jul 21 1998 Drop minus sign for values of -0 + * Sep 29 1998 Treat hyphen-separated date as old format if 2-digit year + * Oct 7 1998 Clean up search for last blank line + * + * Apr 5 1999 Check lengths of strings before copying them + * May 5 1999 values.h -> POSIX limits.h: MAXINT->INT_MAX, MAXSHORT->SHRT_MAX + * Jul 15 1999 Add hgetm() options of 1- or 2-digit keyword extensions + * Oct 6 1999 Add gethlength() to return header length + * Oct 14 1999 In ksearch(), search only to null not to end of buffer + * Oct 15 1999 Return 1 from hgetndec() if successful + * Oct 20 1999 Drop unused variable after lint (val in hgetndec) + * Dec 3 1999 Fix isnum() to reject strings starting with a d or e + * Dec 20 1999 Update hgetdate() to get minutes and seconds right + * + * Feb 10 2000 Parse RA and Dec with spaces as well as colons as separators + * Feb 11 2000 Add null at end of multi-line keyword value character string + * Feb 25 2000 Change max search string length from 57600 to 256000 + * Mar 15 2000 Deal with missing second quotes in string values + * Mar 17 2000 Return 2 from isnum() if number is floating point (.de) + * Mar 17 2000 Ignore leading # for numeric values in header + * Mar 21 2000 Implement -n to get string value starting with nth token + * Apr 5 2000 Reject +- in isnum() + * Jun 9 2000 Read keyword values even if no equal sign is present + * Sep 20 2000 Ignore linefeed at end of number in isnum() + * Oct 23 2000 Fix handling of embedded + or - in isnum() + * + * Jan 19 2000 Return 0 from isnum(), str2ra(), and str2dec() if string is null + * Mar 30 2001 Fix header length finding algorithm in ksearch() + * Jul 13 2001 Make val[] static int instead of int; drop unused variables + * Sep 12 2001 Read yyyy/mm/dd dates as well as dd/mm/yyyy + * Sep 20 2001 Ignore leading spaces in str2dec() + * Sep 20 2001 Ignore trailing spaces in isnum() + * + * Apr 3 2002 Add hgetr8c(), hgeti4c(), and hgetsc() for multiple WCS handling + * Apr 26 2002 Fix bug in hgetsc(), hgeti4c(), and hgetr8c() found by Bill Joye + * Jun 26 2002 Do not drop leading or trailing spaces in multi-line values + * Aug 6 2002 Add strcsrch() and strncsrch() for case-insensitive searches + * Aug 30 2002 Fix bug so strcsrch() really is case-insensitive + * Oct 20 2003 Add numdec() to return number of decimal places in a string + * Dec 9 2003 Fix numdec() to return 0 if no digits after decimal point + * + * Feb 26 2004 Extract value from keyword=value strings within a keyword value + * Apr 9 2004 Use strncsrch() in ksearch() to find differently-cased keywords + * Apr 28 2004 Free os2 in strncsrch() only if it is allocated + * Jul 13 2004 Accept D, d, E, or e as exponent delimiter in floating points + * Aug 30 2004 Change numdec() to accept sexigesimal numbers (:'s) + * + * Jun 27 2005 Drop unused variables + * Aug 30 2005 Adjust code in hlength() + * + * Jun 20 2006 Initialize uninitialized variables in strnsrch() + * Jun 29 2006 Add new subroutine strfix() to clean strings for other uses + * Jul 13 2006 Increase maximum number of multiline keywords from 20 to 500 + * + * Jan 4 2007 Declare header, keyword to be const + * Jan 4 2007 Change WCS letter from char to char* + * Feb 28 2007 If header length is not set in hlength, set it to 0 + * May 31 2007 Add return value of 3 to isnum() if string has colon(s) + * Aug 22 2007 If closing quote not found, make one up + * + * Nov 12 2009 In strfix(), if drop enclosing parantheses + * + * Apr 19 2011 In str2dec(), change comma to space + * May 19 2011 In strncsrch() always free allocated memory before returning + */ diff --git a/tksao/wcssubs/hput.c b/tksao/wcssubs/hput.c new file mode 100644 index 0000000..7ec81ab --- /dev/null +++ b/tksao/wcssubs/hput.c @@ -0,0 +1,1316 @@ +/*** File libwcs/hput.c + *** September 9, 2011 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1995-2011 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: hput.c (Put FITS Header parameter values) + * Purpose: Implant values for parameters into FITS header string + * Subroutine: hputi4 (hstring,keyword,ival) sets int ival + * Subroutine: hputr4 (hstring,keyword,rval) sets real*4 rval + * Subroutine: hputr8 (hstring,keyword,dval) sets real*8 dval + * Subroutine: hputnr8 (hstring,keyword,ndec,dval) sets real*8 dval + * Subroutine: hputra (hstring,keyword,lval) sets right ascension as string + * Subroutine: hputdec (hstring,keyword,lval) sets declination as string + * Subroutine: hputl (hstring,keyword,lval) sets logical lval + * Subroutine: hputs (hstring,keyword,cval) sets character string adding '' + * Subroutine: hputm (hstring,keyword,cval) sets multi-line character string + * Subroutine: hputc (hstring,keyword,cval) sets character string cval + * Subroutine: hdel (hstring,keyword) deletes entry for keyword keyword + * Subroutine: hadd (hplace,keyword) adds entry for keyword at hplace + * Subroutine: hchange (hstring,keyword1,keyword2) changes keyword for entry + * Subroutine: hputcom (hstring,keyword,comment) sets comment for parameter keyword + * Subroutine: ra2str (out, lstr, ra, ndec) converts RA from degrees to string + * Subroutine: dec2str (out, lstr, dec, ndec) converts Dec from degrees to string + * Subroutine: deg2str (out, lstr, deg, ndec) converts degrees to string + * Subroutine: num2str (out, num, field, ndec) converts number to string + * Subroutine: getltime () returns current local time as ISO-style string + * Subroutine: getutime () returns current UT as ISO-style string + */ +#include <sys/time.h> +#include <string.h> /* NULL, strlen, strstr, strcpy */ +#include <stdio.h> +#include <stdlib.h> +#include <math.h> +#include "fitshead.h" + +static int verbose=0; /* Set to 1 to print error messages and other info */ + +static void fixnegzero(); + + +/* HPUTI4 - Set int keyword = ival in FITS header string */ + +int +hputi4 (hstring,keyword,ival) + +char *hstring; /* FITS-style header information in the format + <keyword>= <value> {/ <comment>} + each entry is padded with spaces to 80 characters */ + +const char *keyword; /* Name of the variable in header to be returned. + If no line begins with this string, one is created. + The first 8 characters of keyword must be unique. */ +int ival; /* int number */ +{ + char value[30]; + + /* Translate value from binary to ASCII */ + sprintf (value,"%d",ival); + + /* Put value into header string */ + return (hputc (hstring,keyword,value)); +} + + +/* HPUTR4 - Set float keyword = rval in FITS header string */ + +int +hputr4 (hstring, keyword, rval) + +char *hstring; /* FITS header string */ +const char *keyword; /* Keyword name */ +const float *rval; /* float number */ + +{ + char value[30]; + + /* Translate value from binary to ASCII */ + sprintf (value, "%f", *rval); + + /* Remove sign if string is -0 or extension thereof */ + fixnegzero (value); + + /* Put value into header string */ + return (hputc (hstring, keyword, value)); +} + + +/* HPUTR8 - Set double keyword = dval in FITS header string */ + +int +hputr8 (hstring, keyword, dval) + +char *hstring; /* FITS header string */ +const char *keyword; /* Keyword name */ +const double dval; /* double number */ +{ + char value[30]; + + /* Translate value from binary to ASCII */ + sprintf (value, "%g", dval); + + /* Remove sign if string is -0 or extension thereof */ + fixnegzero (value); + + /* Put value into header string */ + return (hputc (hstring, keyword, value)); +} + + +/* HPUTNR8 - Set double keyword = dval in FITS header string */ + +int +hputnr8 (hstring, keyword, ndec, dval) + +char *hstring; /* FITS header string */ +const char *keyword; /* Keyword name */ +const int ndec; /* Number of decimal places to print */ +const double dval; /* double number */ +{ + char value[30]; + char format[8]; + int i, lval; + + /* Translate value from binary to ASCII */ + if (ndec < 0) { + sprintf (format, "%%.%dg", -ndec); + sprintf (value, format, dval); + lval = (int) strlen (value); + for (i = 0; i < lval; i++) + if (value[i] == 'e') value[i] = 'E'; + } + else { + sprintf (format, "%%.%df", ndec); + sprintf (value, format, dval); + } + + /* Remove sign if string is -0 or extension thereof */ + fixnegzero (value); + + /* Put value into header string */ + return (hputc (hstring, keyword, value)); +} + + +/* HPUTRA - Set double keyword = hh:mm:ss.sss in FITS header string */ + +int +hputra (hstring, keyword, ra) + +char *hstring; /* FITS header string */ +const char *keyword; /* Keyword name */ +const double ra; /* Right ascension in degrees */ +{ + char value[30]; + + /* Translate value from binary to ASCII */ + ra2str (value, 30, ra, 3); + + /* Remove sign if string is -0 or extension thereof */ + fixnegzero (value); + + /* Put value into header string */ + return (hputs (hstring, keyword, value)); +} + + +/* HPUTDEC - Set double keyword = dd:mm:ss.sss in FITS header string */ + +int +hputdec (hstring, keyword, dec) + +char *hstring; /* FITS header string */ +const char *keyword; /* Keyword name */ +const double dec; /* Declination in degrees */ +{ + char value[30]; + + /* Translate value from binary to ASCII */ + dec2str (value, 30, dec, 2); + + /* Remove sign if string is -0 or extension thereof */ + fixnegzero (value); + + /* Put value into header string */ + return (hputs (hstring, keyword, value)); +} + + +/* FIXNEGZERO -- Drop - sign from beginning of any string which is all zeros */ + +static void +fixnegzero (string) + +char *string; +{ + int i, lstr; + + if (string[0] != '-') + return; + + /* Drop out if any non-zero digits in this string */ + lstr = (int) strlen (string); + for (i = 1; i < lstr; i++) { + if (string[i] > '0' && string[i] <= '9') + return; + if (string[i] == 'd' || string[i] == 'e' || string[i] == ' ') + break; + } + + /* Drop - from start of string; overwrite string in place */ + for (i = 1; i < lstr; i++) + string[i-1] = string[i]; + string[lstr-1] = (char) 0; + + return; +} + + + +/* HPUTL - Set keyword = F if lval=0, else T, in FITS header string */ + +int +hputl (hstring, keyword,lval) + +char *hstring; /* FITS header */ +const char *keyword; /* Keyword name */ +const int lval; /* logical variable (0=false, else true) */ +{ + char value[8]; + + /* Translate value from binary to ASCII */ + if (lval) + strcpy (value, "T"); + else + strcpy (value, "F"); + + /* Put value into header string */ + return (hputc (hstring,keyword,value)); +} + + +/* HPUTM - Set multi-line character string in FITS header string */ +/* return number of keywords written */ + +int +hputm (hstring,keyword,cval) + +char *hstring; /* FITS header */ +const char *keyword; /* Keyword name root (6 characters or less) */ +const char *cval; /* character string containing the value for variable + keyword. trailing and leading blanks are removed. */ +{ + int lroot, lcv, i, ii, nkw, lkw, lval; + int comment = 0; + const char *v; + char keyroot[8], newkey[12], value[80]; + char squot = 39; + + /* If COMMENT or HISTORY, use the same keyword on every line */ + lkw = (int) strlen (keyword); + if (lkw == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) { + comment = 1; + lroot = 0; + } + + /* Set up keyword root, shortening it to 6 characters, if necessary */ + else { + comment = 0; + strcpy (keyroot, keyword); + lroot = (int) strlen (keyroot); + if (lroot > 6) { + keyroot[6] = (char) 0; + lroot = 6; + } + } + + /* Write keyword value one line of up to 67 characters at a time */ + ii = '1'; + nkw = 0; + lcv = (int) strlen (cval); + if (!comment) { + strcpy (newkey, keyroot); + strcat (newkey, "_"); + newkey[lroot+2] = (char) 0; + } + v = cval; + while (lcv > 0) { + if (lcv > 67) + lval = 67; + else + lval = lcv; + value[0] = squot; + for (i = 1; i <= lval; i++) + value[i] = *v++; + + /* Pad short strings to 8 characters */ + if (lval < 8) { + for (i = lval+1; i < 9; i++) + value[i] = ' '; + lval = 8; + } + value[lval+1] = squot; + value[lval+2] = (char) 0; + + /* Add this line to the header */ + if (comment) + i = hputc (hstring, keyroot, value); + else { + newkey[lroot+1] = ii; + ii++; + i = hputc (hstring, newkey, value); + } + if (i != 0) return (i); + nkw++; + if (lcv > 67) + lcv = lcv - 67; + else + break; + } + return (nkw); +} + + +/* HPUTS - Set character string keyword = 'cval' in FITS header string */ + +int +hputs (hstring,keyword,cval) + +char *hstring; /* FITS header */ +const char *keyword; /* Keyword name */ +const char *cval; /* character string containing the value for variable + keyword. trailing and leading blanks are removed. */ +{ + char squot = 39; + char value[80]; + int lcval, i, lkeyword; + + /* If COMMENT or HISTORY, just add it as is */ + lkeyword = (int) strlen (keyword); + if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) + return (hputc (hstring,keyword,cval)); + + /* find length of variable string */ + lcval = (int) strlen (cval); + if (lcval > 67) + lcval = 67; + + /* Put single quote at start of string */ + value[0] = squot; + strncpy (&value[1],cval,lcval); + + /* If string is less than eight characters, pad it with spaces */ + if (lcval < 8) { + for (i = lcval; i < 8; i++) { + value[i+1] = ' '; + } + lcval = 8; + } + + /* Add single quote and null to end of string */ + value[lcval+1] = squot; + value[lcval+2] = (char) 0; + + /* Put value into header string */ + return (hputc (hstring,keyword,value)); +} + + +/* HPUTC - Set character string keyword = value in FITS header string */ +/* Return -1 if error, 0 if OK */ + +int +hputc (hstring,keyword,value) + +char *hstring; +const char *keyword; +const char *value; /* character string containing the value for variable + keyword. trailing and leading blanks are removed. */ +{ + char squot = 39; + char line[100]; + char newcom[50]; + char *vp, *v1, *v2, *q1, *q2, *c1, *ve; + int lkeyword, lcom, lval, lc, lv1, lhead, lblank, ln, nc, i; + + /* Find length of keyword, value, and header */ + lkeyword = (int) strlen (keyword); + lval = (int) strlen (value); + lhead = gethlength (hstring); + + /* If COMMENT or HISTORY, always add it just before the END */ + if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) { + + /* First look for blank lines before END */ + v1 = blsearch (hstring, "END"); + + /* Otherwise, create a space for it at the end of the header */ + if (v1 == NULL) { + + /* Find end of header */ + v1 = ksearch (hstring,"END"); + + /* Align pointer at start of 80-character line */ + lc = v1 - hstring; + ln = lc / 80; + nc = ln * 80; + v1 = hstring + nc; + v2 = v1 + 80; + + /* If header length is exceeded, return error code */ + if (v2 - hstring > lhead) { + return (-1); + } + + /* Move END down 80 characters */ + strncpy (v2, v1, 80); + } + else + v2 = v1 + 80; + + /* Insert keyword */ + strncpy (v1,keyword,7); + + /* Pad with spaces */ + for (vp = v1+lkeyword; vp < v2; vp++) + *vp = ' '; + + if (lval > 71) + lv1 = 71; + else + lv1 = lval; + + /* Insert comment */ + strncpy (v1+9,value,lv1); + return (0); + } + + /* Otherwise search for keyword */ + else + v1 = ksearch (hstring,keyword); + + /* If parameter is not found, find a place to put it */ + if (v1 == NULL) { + + /* First look for blank lines before END */ + v1 = blsearch (hstring, "END"); + + /* Otherwise, create a space for it at the end of the header */ + if (v1 == NULL) { + ve = ksearch (hstring,"END"); + v1 = ve; + + /* Align pointer at start of 80-character line */ + lc = v1 - hstring; + ln = lc / 80; + nc = ln * 80; + v1 = hstring + nc; + v2 = v1 + 80; + + /* If header length is exceeded, return error code */ + if (v2 - hstring > lhead) { + return (-1); + } + + strncpy (v2, ve, 80); + } + else + v2 = v1 + 80; + lcom = 0; + newcom[0] = 0; + } + + /* Otherwise, extract the entry for this keyword from the header */ + else { + + /* Align pointer at start of 80-character line */ + lc = v1 - hstring; + ln = lc / 80; + nc = ln * 80; + v1 = hstring + nc; + v2 = v1 + 80; + + strncpy (line, v1, 80); + line[80] = 0; + v2 = v1 + 80; + + /* check for quoted value */ + q1 = strchr (line, squot); + if (q1 != NULL) { + q2 = strchr (q1+1,squot); + if (q2 != NULL) + c1 = strchr (q2,'/'); + else + c1 = strrchr (line+79,'/'); + } + else + c1 = strchr (line,'/'); + + /* extract comment and discount trailing spaces */ + if (c1 != NULL) { + lcom = 80 - (c1 + 2 - line); + strncpy (newcom, c1+2, lcom); + vp = newcom + lcom - 1; + while (vp-- > newcom && *vp == ' ') + lcom--; + } + else { + newcom[0] = 0; + lcom = 0; + } + } + + /* Fill new entry with spaces */ + for (vp = v1; vp < v2; vp++) + *vp = ' '; + + /* Copy keyword to new entry */ + strncpy (v1, keyword, lkeyword); + + /* Add parameter value in the appropriate place */ + vp = v1 + 8; + *vp = '='; + vp = v1 + 9; + *vp = ' '; + vp = vp + 1; + if (*value == squot) { + strncpy (vp, value, lval); + if (lval+12 > 31) + lc = lval + 12; + else + lc = 30; + } + else { + vp = v1 + 30 - lval; + strncpy (vp, value, lval); + lc = 30; + } + + /* Add comment in the appropriate place */ + if (lcom > 0) { + if (lc+2+lcom > 80) + lcom = 77 - lc; + vp = v1 + lc; /* Jul 16 1997: was vp = v1 + lc * 2 */ + *vp++ = ' '; + *vp++ = '/'; + *vp++ = ' '; + lblank = v2 - vp; + for (i = 0; i < lblank; i++) + vp[i] = ' '; + if (lcom > lblank) + lcom = lblank; + strncpy (vp, newcom, lcom); + } + + if (verbose) { + if (lcom > 0) + fprintf (stderr,"HPUT: %s = %s / %s\n",keyword, value, newcom); + else + fprintf (stderr,"HPUT: %s = %s\n",keyword, value); + } + + return (0); +} + + +/* HPUTCOM - Set comment for keyword or on line in FITS header string */ + +int +hputcom (hstring,keyword,comment) + + char *hstring; + const char *keyword; + const char *comment; +{ + char squot, slash, space; + char line[100]; + int lkeyword, lcom, lhead, i, lblank, ln, nc, lc; + char *vp, *v1, *v2, *c0, *c1, *q1, *q2; + + squot = (char) 39; + slash = (char) 47; + space = (char) 32; + + /* Find length of variable name */ + lkeyword = (int) strlen (keyword); + lhead = gethlength (hstring); + lcom = (int) strlen (comment); + + /* If COMMENT or HISTORY, always add it just before the END */ + if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 || + strncmp (keyword,"HISTORY",7) == 0)) { + + /* Find end of header */ + v1 = ksearch (hstring,"END"); + + /* Align pointer at start of 80-character line */ + lc = v1 - hstring; + ln = lc / 80; + nc = ln * 80; + v1 = hstring + nc; + v2 = v1 + 80; + + /* If header length is exceeded, return error code */ + if (v2 - hstring > lhead) { + return (-1); + } + + /* Move END down 80 characters */ + strncpy (v2, v1, 80); + + /* blank out new line and insert keyword */ + for (vp = v1; vp < v2; vp++) + *vp = ' '; + strncpy (v1, keyword, lkeyword); + c0 = v1 + lkeyword; + } + + /* Search header string for variable name */ + else { + v1 = ksearch (hstring,keyword); + + /* If parameter is not found, return without doing anything */ + if (v1 == NULL) { + if (verbose) + fprintf (stderr,"HPUTCOM: %s not found\n",keyword); + return (-1); + } + + /* Align pointer at start of 80-character line */ + lc = v1 - hstring; + ln = lc / 80; + nc = ln * 80; + v1 = hstring + nc; + v2 = v1 + 80; + + /* Extract entry for this variable from the header */ + strncpy (line, v1, 80); + line[80] = '\0'; /* Null-terminate line before strchr call */ + + /* check for quoted value */ + q1 = strchr (line,squot); + c1 = strchr (line,slash); + if (q1 != NULL) { + if (c1 != NULL && q1 < c1) { + q2 = strchr (q1+1, squot); + if (q2 == NULL) { + q2 = c1 - 1; + while (*q2 == space) + q2--; + q2++; + } + else if (c1 < q2) + c1 = strchr (q2, slash); + } + else if (c1 == NULL) { + q2 = strchr (q1+1, squot); + if (q2 == NULL) { + q2 = line + 79; + while (*q2 == space) + q2--; + q2++; + } + } + else + q1 = NULL; + q2 = NULL; + } + + else + q2 = NULL; + + if (c1 != NULL) + c0 = v1 + (c1 - line) - 1; + else if (q2 == NULL || q2-line < 30) + c0 = v1 + 30; + else + c0 = v1 + (q2 - line) + 1; /* allan: 1997-09-30, was c0=q2+2 */ + + /* If comment will not fit at all, return */ + if (c0 - v1 > 77) + return (-1); + strncpy (c0, " / ",3); + } + + /* Create new entry */ + if (lcom > 0) { + c1 = c0 + 3; + lblank = v1 + 79 - c1; + if (lcom > lblank) + lcom = lblank; + for (i = 0; i < lblank; i++) + c1[i] = ' '; + strncpy (c1, comment, lcom); + } + + if (verbose) { + fprintf (stderr,"HPUTCOM: %s / %s\n",keyword,comment); + } + return (0); +} + + +static int leaveblank = 0; /* If 1, leave blank line when deleting */ +void +setleaveblank (lb) +int lb; { leaveblank = lb; return; } + +static int headshrink=1; /* Set to 1 to drop line after deleting keyword */ +void +setheadshrink (hsh) +int hsh; +{headshrink = hsh; return;} + +/* HDEL - Set character string keyword = value in FITS header string + * returns 1 if entry deleted, else 0 + */ + +int +hdel (hstring,keyword) + +char *hstring; /* FITS header */ +const char *keyword; /* Keyword of entry to be deleted */ +{ + char *v, *v1, *v2, *ve; + + /* Search for keyword */ + v1 = ksearch (hstring,keyword); + + /* If keyword is not found, return header unchanged */ + if (v1 == NULL) { + return (0); + } + + /* Find end of header */ + ve = ksearch (hstring,"END"); + + /* If headshrink is 0, leave END where it is */ + if (!leaveblank && !headshrink) + ve = ve - 80; + + /* Cover deleted keyword line with spaces */ + if (leaveblank) { + v2 = v1 + 80; + for (v = ve; v < v2; v++) + *v = ' '; + } + + /* Shift rest of header up one line */ + else { + for (v = v1; v < ve; v = v + 80) { + v2 = v + 80; + strncpy (v, v2, 80); + } + + /* Cover former last line with spaces */ + v2 = ve + 80; + for (v = ve; v < v2; v++) + *v = ' '; + } + + return (1); +} + + +/* HADD - Add character string keyword = value to FITS header string + * returns 1 if entry added, else 0 + * Call hputx() to put value into entry + */ + +int +hadd (hplace, keyword) + +char *hplace; /* FITS header position for new keyword */ +const char *keyword; /* Keyword of entry to be deleted */ +{ + char *v, *v1, *v2, *ve; + int i, lkey; + + /* Find end of header */ + ve = ksearch (hplace,"END"); + + /* If END is not found, return header unchanged */ + if (ve == NULL) { + return (0); + } + + v1 = hplace; + + /* Shift rest of header down one line */ + /* limit bug found by Paolo Montegriffo fixed 2000-04-19 */ + for (v = ve; v >= v1; v = v - 80) { + v2 = v + 80; + strncpy (v2, v, 80); + } + + /* Cover former first line with new keyword */ + lkey = (int) strlen (keyword); + strncpy (hplace, keyword, lkey); + if (lkey < 8) { + for (i = lkey; i < 8; i++) + hplace[i] = ' '; + hplace[8] = '='; + } + for (i = 9; i < 80; i++) + hplace[i] = ' '; + + return (1); +} + + +/* HCHANGE - Changes keyword for entry from keyword1 to keyword2 in FITS + header string + * returns 1 if entry changed, else 0 + */ + +int +hchange (hstring, keyword1, keyword2) + +char *hstring; /* FITS header */ +const char *keyword1; /* Keyword to be changed */ +const char *keyword2; /* New keyword name */ +{ + char *v, *v1; + const char *v2; + int lv2, i; + + /* Search for keyword */ + v1 = ksearch (hstring,keyword1); + + /* If keyword is not found, return header unchanged */ + if (!v1) + return (0); + + else { + lv2 = (int) strlen (keyword2); + v = v1; + v2 = keyword2; + for (i = 0; i < 8; i++) { + if (i < lv2) + v[i] = v2[i]; + else + v[i] = ' '; + } + } + + return (1); +} + + +/* Write the right ascension ra in sexagesimal format into string*/ + +void +ra2str (string, lstr, ra, ndec) + +char *string; /* Character string (returned) */ +int lstr; /* Maximum number of characters in string */ +double ra; /* Right ascension in degrees */ +int ndec; /* Number of decimal places in seconds */ + +{ + double a,b; + double seconds; + char tstring[64]; + int hours; + int minutes; + int isec, ltstr; + double dsgn; + + /* Keep RA between 0 and 360 */ + if (ra < 0.0 ) { + ra = -ra; + dsgn = -1.0; + } + else + dsgn = 1.0; + ra = fmod(ra, 360.0); + ra *= dsgn; + if (ra < 0.0) + ra = ra + 360.0; + + a = ra / 15.0; + + /* Convert to hours */ + hours = (int) a; + + /* Compute minutes */ + b = (a - (double)hours) * 60.0; + minutes = (int) b; + + /* Compute seconds */ + seconds = (b - (double)minutes) * 60.0; + + if (ndec > 5) { + if (seconds > 59.999999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%09.6f",hours,minutes,seconds); + } + else if (ndec > 4) { + if (seconds > 59.99999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%08.5f",hours,minutes,seconds); + } + else if (ndec > 3) { + if (seconds > 59.9999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%07.4f",hours,minutes,seconds); + } + else if (ndec > 2) { + if (seconds > 59.999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%06.3f",hours,minutes,seconds); + } + else if (ndec > 1) { + if (seconds > 59.99) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%05.2f",hours,minutes,seconds); + } + else if (ndec > 0) { + if (seconds > 59.9) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%04.1f",hours,minutes,seconds); + } + else { + isec = (int)(seconds + 0.5); + if (isec > 59) { + isec = 0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + hours = hours + 1; + } + hours = hours % 24; + (void) sprintf (tstring,"%02d:%02d:%02d",hours,minutes,isec); + } + + /* Move formatted string to returned string */ + ltstr = (int) strlen (tstring); + if (ltstr < lstr-1) + strcpy (string, tstring); + else { + strncpy (string, tstring, lstr-1); + string[lstr-1] = 0; + } + return; +} + + +/* Write the variable a in sexagesimal format into string */ + +void +dec2str (string, lstr, dec, ndec) + +char *string; /* Character string (returned) */ +int lstr; /* Maximum number of characters in string */ +double dec; /* Declination in degrees */ +int ndec; /* Number of decimal places in arcseconds */ + +{ + double a, b, dsgn, deg1; + double seconds; + char sign; + int degrees; + int minutes; + int isec, ltstr; + char tstring[64]; + + /* Keep angle between -180 and 360 degrees */ + deg1 = dec; + if (deg1 < 0.0 ) { + deg1 = -deg1; + dsgn = -1.0; + } + else + dsgn = 1.0; + deg1 = fmod(deg1, 360.0); + deg1 *= dsgn; + if (deg1 <= -180.0) + deg1 = deg1 + 360.0; + + a = deg1; + + /* Set sign and do all the rest with a positive */ + if (a < 0) { + sign = '-'; + a = -a; + } + else + sign = '+'; + + /* Convert to degrees */ + degrees = (int) a; + + /* Compute minutes */ + b = (a - (double)degrees) * 60.0; + minutes = (int) b; + + /* Compute seconds */ + seconds = (b - (double)minutes) * 60.0; + + if (ndec > 5) { + if (seconds > 59.999999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%09.6f",sign,degrees,minutes,seconds); + } + else if (ndec > 4) { + if (seconds > 59.99999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%08.5f",sign,degrees,minutes,seconds); + } + else if (ndec > 3) { + if (seconds > 59.9999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%07.4f",sign,degrees,minutes,seconds); + } + else if (ndec > 2) { + if (seconds > 59.999) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%06.3f",sign,degrees,minutes,seconds); + } + else if (ndec > 1) { + if (seconds > 59.99) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%05.2f",sign,degrees,minutes,seconds); + } + else if (ndec > 0) { + if (seconds > 59.9) { + seconds = 0.0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%04.1f",sign,degrees,minutes,seconds); + } + else { + isec = (int)(seconds + 0.5); + if (isec > 59) { + isec = 0; + minutes = minutes + 1; + } + if (minutes > 59) { + minutes = 0; + degrees = degrees + 1; + } + (void) sprintf (tstring,"%c%02d:%02d:%02d",sign,degrees,minutes,isec); + } + + /* Move formatted string to returned string */ + ltstr = (int) strlen (tstring); + if (ltstr < lstr-1) + strcpy (string, tstring); + else { + strncpy (string, tstring, lstr-1); + string[lstr-1] = 0; + } + return; +} + + +/* Write the angle a in decimal format into string */ + +void +deg2str (string, lstr, deg, ndec) + +char *string; /* Character string (returned) */ +int lstr; /* Maximum number of characters in string */ +double deg; /* Angle in degrees */ +int ndec; /* Number of decimal places in degree string */ + +{ + char degform[8]; + int field, ltstr; + char tstring[64]; + double deg1; + double dsgn; + + /* Keep angle between -180 and 360 degrees */ + deg1 = deg; + if (deg1 < 0.0 ) { + deg1 = -deg1; + dsgn = -1.0; + } + else + dsgn = 1.0; + deg1 = fmod(deg1, 360.0); + deg1 *= dsgn; + if (deg1 <= -180.0) + deg1 = deg1 + 360.0; + + /* Write angle to string, adding 4 digits to number of decimal places */ + field = ndec + 4; + if (ndec > 0) { + sprintf (degform, "%%%d.%df", field, ndec); + sprintf (tstring, degform, deg1); + } + else { + sprintf (degform, "%%%4d", field); + sprintf (tstring, degform, (int)deg1); + } + + /* Move formatted string to returned string */ + ltstr = (int) strlen (tstring); + if (ltstr < lstr-1) + strcpy (string, tstring); + else { + strncpy (string, tstring, lstr-1); + string[lstr-1] = 0; + } + return; +} + + +/* Write the variable a in decimal format into field-character string */ + +void +num2str (string, num, field, ndec) + +char *string; /* Character string (returned) */ +double num; /* Number */ +int field; /* Number of characters in output field (0=any) */ +int ndec; /* Number of decimal places in degree string */ + +{ + char numform[8]; + + if (field > 0) { + if (ndec > 0) { + sprintf (numform, "%%%d.%df", field, ndec); + sprintf (string, numform, num); + } + else { + sprintf (numform, "%%%dd", field); + sprintf (string, numform, (int)num); + } + } + else { + if (ndec > 0) { + sprintf (numform, "%%.%df", ndec); + sprintf (string, numform, num); + } + else { + sprintf (string, "%d", (int)num); + } + } + return; +} + +/* Dec 14 1995 Original subroutines + + * Feb 5 1996 Added HDEL to delete keyword entry from FITS header + * Feb 7 1996 Add EOS to LINE in HPUTC + * Feb 21 1996 Add RA2STR and DEC2STR string routines + * Jul 19 1996 Add HPUTRA and HPUTDEC + * Jul 22 1996 Add HCHANGE to change keywords + * Aug 5 1996 Add HPUTNR8 to save specific number of decimal places + * Oct 15 1996 Fix spelling + * Nov 1 1996 Add DEG2STR to set specific number of decimal places + * Nov 1 1996 Allow DEC2STR to handle upt to 6 decimal places + * + * Mar 20 1997 Fix format error in DEG2STR + * Jul 7 1997 Fix 2 errors in HPUTCOM found by Allan Brighton + * Jul 16 1997 Fix error in HPUTC found by Allan Brighton + * Jul 17 1997 Fix error in HPUTC found by Allan Brighton + * Sep 30 1997 Fix error in HPUTCOM found by Allan Brighton + * Dec 15 1997 Fix minor bugs after lint + * Dec 31 1997 Always put two hour digits in RA2STR + * + * Feb 25 1998 Add HADD to insert keywords at specific locations + * Mar 27 1998 If n is negative, write g format in HPUTNR8() + * Apr 24 1998 Add NUM2STR() for easy output formatting + * Apr 30 1998 Use BLSEARCH() to overwrite blank lines before END + * May 27 1998 Keep Dec between -90 and +90 in DEC2STR() + * May 28 1998 Keep RA between 0 and 360 in RA2STR() + * Jun 2 1998 Fix bug when filling in blank lines before END + * Jun 24 1998 Add string length to ra2str(), dec2str(), and deg2str() + * Jun 25 1998 Make string converstion subroutines more robust + * Aug 31 1998 Add getltime() and getutime() + * Sep 28 1998 Null-terminate comment in HPUTCOM (Allan Brighton) + * Oct 1 1998 Change clock declaration in getltime() from int (Allan Brighton) + * + * Jan 28 1999 Fix bug to avoid writing HISTORY or COMMENT past 80 characters + * Jul 14 1999 Pad string in hputs() to minimum of 8 characters + * Aug 16 1999 Keep angle between -180 and +360 in dec2str() + * Oct 6 1999 Reallocate header buffer if it is too small in hputc() + * Oct 14 1999 Do not reallocate header; return error if not successful + * + * Mar 2 2000 Do not add quotes if adding HISTORY or COMMENT with hputs() + * Mar 22 2000 Move getutime() and getltime() to dateutil.c + * Mar 27 2000 Add hputm() for muti-line keywords + * Mar 27 2000 Fix bug testing for space to fit comment in hputcom() + * Apr 19 2000 Fix bug in hadd() which overwrote line + * Jun 2 2000 Dropped unused variable lv in hputm() after lint + * Jul 20 2000 Drop unused variables blank and i in hputc() + * + * Jan 11 2001 Print all messages to stderr + * Jan 18 2001 Drop declaration of blsearch(); it is in fitshead.h + * + * Jan 4 2002 Fix placement of comments + * + * Jul 1 2004 Add headshrink to optionally keep blank lines in header + * Sep 3 2004 Fix bug so comments are not pushed onto next line if long value + * Sep 16 2004 Add fixnegzero() to avoid putting signed zero values in header + * + * May 22 2006 Add option to leave blank line when deleting a keyword + * Jun 15 2006 Fix comment alignment in hputc() and hputcom() + * Jun 20 2006 Initialized uninitialized variables in hputm() and hputcom() + * + * Jan 4 2007 Declare keyword to be const + * Jan 4 2007 Drop unused subroutine hputi2() + * Jan 5 2007 Drop ksearch() declarations; it is now in fitshead.h + * Jan 16 2007 Fix bugs in ra2str() and dec2str() so ndec=0 works + * Aug 20 2007 Fix bug so comments after quoted keywords work + * Aug 22 2007 If closing quote not found, make one up + * + * Sep 9 2011 Always initialize q2 and lroot + */ diff --git a/tksao/wcssubs/iget.c b/tksao/wcssubs/iget.c new file mode 100644 index 0000000..58e54f7 --- /dev/null +++ b/tksao/wcssubs/iget.c @@ -0,0 +1,531 @@ +/*** File libwcs/iget.c + *** January 4, 2007 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1998-2007 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: iget.c (Get IRAF FITS Header parameter values) + * Purpose: Extract values for variables from IRAF keyword value string + * Subroutine: mgeti4 (hstring,mkey,keyword,ival) returns long integer + * Subroutine: mgetr8 (hstring,mkey,keyword,dval) returns double + * Subroutine: mgetstr (hstring,mkey,keyword,lstr,str) returns character string + * Subroutine: igeti4 (hstring,keyword,ival) returns long integer + * Subroutine: igetr4 (hstring,keyword,rval) returns real + * Subroutine: igetr8 (hstring,keyword,dval) returns double + * Subroutine: igets (hstring,keyword,lstr,str) returns character string + * Subroutine: igetc (hstring,keyword) returns character string + * Subroutine: isearch (hstring,keyword) returns pointer to header string entry + */ + +#include <string.h> /* NULL, strlen, strstr, strcpy */ +#include <stdio.h> +#include "fitshead.h" /* FITS header extraction subroutines */ +#include <stdlib.h> +#ifndef VMS +#include <limits.h> +#else +#define INT_MAX 2147483647 /* Biggest number that can fit in long */ +#define SHRT_MAX 32767 +#endif + +#define MAX_LVAL 2000 + +static char *isearch(); +static char val[30]; + +/* Extract long value for variable from IRAF multiline keyword value */ + +int +mgeti4 (hstring, mkey, keyword, ival) + +const char *hstring; /* Character string containing FITS or IRAF header information + in the format <keyword>= <value> ... */ +const char *mkey; /* Character string containing the name of the multi-line + keyword, the string value of which contains the desired + keyword, the value of which is returned. */ +const char *keyword; /* Character string containing the name of the keyword + within the multiline IRAF keyword */ +int *ival; /* Integer value returned */ +{ + char *mstring; + + mstring = malloc (MAX_LVAL); + + if (hgetm (hstring, mkey, MAX_LVAL, mstring)) { + if (igeti4 (mstring, keyword, ival)) { + free (mstring); + return (1); + } + else { + free (mstring); + return (0); + } + } + else { + free (mstring); + return (0); + } +} + +/* Extract double value for variable from IRAF multiline keyword value */ + +int +mgetr8 (hstring, mkey, keyword, dval) + +const char *hstring; /* Character string containing FITS or IRAF header information + in the format <keyword>= <value> ... */ +const char *mkey; /* Character string containing the name of the multi-line + keyword, the string value of which contains the desired + keyword, the value of which is returned. */ +const char *keyword; /* Character string containing the name of the keyword + within the multiline IRAF keyword */ +double *dval; /* Integer value returned */ +{ + char *mstring; + mstring = malloc (MAX_LVAL); + + if (hgetm (hstring, mkey, MAX_LVAL, mstring)) { + if (igetr8 (mstring, keyword, dval)) { + free (mstring); + return (1); + } + else { + free (mstring); + return (0); + } + } + else { + free (mstring); + return (0); + } +} + + +/* Extract string value for variable from IRAF keyword value string */ + +int +mgetstr (hstring, mkey, keyword, lstr, str) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *mkey; /* Character string containing the name of the multi-line + keyword, the string value of which contains the desired + keyword, the value of which is returned. */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char *mstring; + mstring = malloc (MAX_LVAL); + + if (hgetm (hstring, mkey, MAX_LVAL, mstring)) { + if (igets (mstring, keyword, lstr, str)) { + free (mstring); + return (1); + } + else { + free (mstring); + return (0); + } + } + else { + free (mstring); + return (0); + } +} + + +/* Extract long value for variable from IRAF keyword value string */ + +int +igeti4 (hstring, keyword, ival) + +const char *hstring; /* character string containing IRAF header information + in the format <keyword>= <value> ... */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +int *ival; /* Integer value returned */ +{ +char *value; +double dval; +int minint; + +/* Get value from header string */ + value = igetc (hstring,keyword); + +/* Translate value from ASCII to binary */ + if (value != NULL) { + minint = -INT_MAX - 1; + strcpy (val, value); + dval = atof (val); + if (dval+0.001 > INT_MAX) + *ival = INT_MAX; + else if (dval >= 0) + *ival = (int) (dval + 0.001); + else if (dval-0.001 < minint) + *ival = minint; + else + *ival = (int) (dval - 0.001); + return (1); + } + else { + return (0); + } +} + + +/* Extract integer*2 value for variable from IRAF keyword value string */ + +int +igeti2 (hstring,keyword,ival) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +short *ival; +{ +char *value; +double dval; +int minshort; + +/* Get value from header string */ + value = igetc (hstring,keyword); + +/* Translate value from ASCII to binary */ + if (value != NULL) { + strcpy (val, value); + dval = atof (val); + minshort = -SHRT_MAX - 1; + if (dval+0.001 > SHRT_MAX) + *ival = SHRT_MAX; + else if (dval >= 0) + *ival = (short) (dval + 0.001); + else if (dval-0.001 < minshort) + *ival = minshort; + else + *ival = (short) (dval - 0.001); + return (1); + } + else { + return (0); + } +} + +/* Extract real value for variable from IRAF keyword value string */ + +int +igetr4 (hstring,keyword,rval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +float *rval; +{ + char *value; + +/* Get value from header string */ + value = igetc (hstring,keyword); + +/* Translate value from ASCII to binary */ + if (value != NULL) { + strcpy (val, value); + *rval = (float) atof (val); + return (1); + } + else { + return (0); + } +} + + +/* Extract real*8 value for variable from IRAF keyword value string */ + +int +igetr8 (hstring,keyword,dval) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +double *dval; +{ + char *value,val[30]; + +/* Get value from header string */ + value = igetc (hstring,keyword); + +/* Translate value from ASCII to binary */ + if (value != NULL) { + strcpy (val, value); + *dval = atof (val); + return (1); + } + else { + return (0); + } +} + + +/* Extract string value for variable from IRAF keyword value string */ + +int +igets (hstring, keyword, lstr, str) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword; /* character string containing the name of the keyword + the value of which is returned. hget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +const int lstr; /* Size of str in characters */ +char *str; /* String (returned) */ +{ + char *value; + int lval; + +/* Get value from header string */ + value = igetc (hstring,keyword); + + if (value != NULL) { + lval = strlen (value); + if (lval < lstr) + strcpy (str, value); + else if (lstr > 1) + strncpy (str, value, lstr-1); + else + str[0] = value[0]; + return (1); + } + else + return (0); +} + + +/* Extract character value for variable from IRAF keyword value string */ + +char * +igetc (hstring,keyword0) + +const char *hstring; /* character string containing IRAF keyword value string + in the format <keyword>= <value> {/ <comment>} */ +const char *keyword0; /* character string containing the name of the keyword + the value of which is returned. iget searches for a + line beginning with this string. if "[n]" is present, + the n'th token in the value is returned. + (the first 8 characters must be unique) */ +{ + static char cval[MAX_LVAL]; + char *value; + char cwhite[8]; + char lbracket[2],rbracket[2]; + char keyword[16]; + char line[MAX_LVAL]; + char *vpos,*cpar; + char *c1, *brack1, *brack2; + int ipar, i; + + lbracket[0] = 91; + lbracket[1] = 0; + rbracket[0] = 93; + rbracket[1] = 0; + +/* Find length of variable name */ + strcpy (keyword,keyword0); + brack1 = strsrch (keyword,lbracket); + if (brack1 != NULL) *brack1 = '\0'; + +/* Search header string for variable name */ + vpos = isearch (hstring,keyword); + +/* Exit if not found */ + if (vpos == NULL) { + return (NULL); + } + +/* Initialize returned value to nulls */ + for (i = 0; i < MAX_LVAL; i++) + line[i] = 0; + +/* If quoted value, copy until second quote is reached */ + i = 0; + if (*vpos == '"') { + vpos++; + while (*vpos && *vpos != '"' && i < MAX_LVAL) + line[i++] = *vpos++; + } + +/* Otherwise copy until next space or tab */ + else { + while (*vpos != ' ' && *vpos != (char)9 && + *vpos > 0 && i < MAX_LVAL) + line[i++] = *vpos++; + } + +/* If keyword has brackets, extract appropriate token from value */ + if (brack1 != NULL) { + c1 = (char *) (brack1 + 1); + brack2 = strsrch (c1, rbracket); + if (brack2 != NULL) { + *brack2 = '\0'; + ipar = atoi (c1); + if (ipar > 0) { + cwhite[0] = ' '; + cwhite[1] = ','; + cwhite[2] = '\0'; + cpar = strtok (line, cwhite); + for (i = 1; i < ipar; i++) { + cpar = strtok (NULL, cwhite); + } + if (cpar != NULL) { + strcpy (cval,cpar); + } + else + value = NULL; + } + } + } + else + strcpy (cval, line); + + value = cval; + + return (value); +} + + +/* Find value for specified IRAF keyword */ + +static char * +isearch (hstring,keyword) + +/* Find entry for keyword keyword in IRAF keyword value string hstring. + NULL is returned if the keyword is not found */ + +const char *hstring; /* character string containing fits-style header + information in the format <keyword>= <value> {/ <comment>} + the default is that each entry is 80 characters long; + however, lines may be of arbitrary length terminated by + nulls, carriage returns or linefeeds, if packed is true. */ +const char *keyword; /* character string containing the name of the variable + to be returned. isearch searches for a line beginning + with this string. The string may be a character + literal or a character variable terminated by a null + or '$'. it is truncated to 8 characters. */ +{ + char *loc, *headnext, *headlast, *pval; + int lastchar, nextchar, lkey, nleft, lhstr; + +/* Search header string for variable name */ + lhstr = 0; + while (lhstr < 57600 && hstring[lhstr] != 0) + lhstr++; + headlast = (char *) hstring + lhstr; + headnext = (char *) hstring; + pval = NULL; + lkey = strlen (keyword); + while (headnext < headlast) { + nleft = headlast - headnext; + loc = strnsrch (headnext, keyword, nleft); + + /* Exit if keyword is not found */ + if (loc == NULL) { + break; + } + + nextchar = (int) *(loc + lkey); + lastchar = (int) *(loc - 1); + + /* If parameter name in header is longer, keep searching */ + if (nextchar != 61 && nextchar > 32 && nextchar < 127) + headnext = loc + 1; + + /* If start of string, keep it */ + else if (loc == hstring) { + pval = loc; + break; + } + + /* If preceeded by a blank or tab, keep it */ + else if (lastchar == 32 || lastchar == 9) { + pval = loc; + break; + } + + else + headnext = loc + 1; + } + + /* Find start of value string for this keyword */ + if (pval != NULL) { + pval = pval + lkey; + while (*pval == ' ' || *pval == '=') + pval++; + } + + /* Return pointer to calling program */ + return (pval); + +} + +/* Mar 12 1998 New subroutines + * Apr 15 1998 Set IGET() and ISEARCH() static when defined + * Apr 24 1998 Add MGETI4(), MGETR8(), and MGETS() for single step IRAF ext. + * Jun 1 1998 Add VMS patch from Harry Payne at STScI + * Jul 9 1998 Fix bracket token extraction after Paul Sydney + + * May 5 1999 values.h -> POSIX limits.h: MAXINT->INT_MAX, MAXSHORT->SHRT_MAX + * Oct 21 1999 Fix declarations after lint + * + * Feb 11 2000 Stop search for end of quoted keyword if more than 500 chars + * Jul 20 2000 Drop unused variables squot, dquot, and slash in igetc() + * + * Jun 26 2002 Change maximum string length from 600 to 2000; use MAX_LVAL + * Jun 26 2002 Stop search for end of quoted keyword if > MAX_LVAL chars + * + * Sep 23 2003 Change mgets() to mgetstr() to avoid name collision at UCO Lick + * + * Feb 26 2004 Make igetc() accessible from outside this file + * + * Jan 4 2007 Declare header, keyword to be const + */ diff --git a/tksao/wcssubs/imhfile.c b/tksao/wcssubs/imhfile.c new file mode 100644 index 0000000..b618686 --- /dev/null +++ b/tksao/wcssubs/imhfile.c @@ -0,0 +1,1941 @@ +/*** File imhfile.c + *** March 27, 2012 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2012 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: imhfile.c (IRAF .imh image file reading and writing) + * Purpose: Read and write IRAF image files (and translate headers) + * Subroutine: check_immagic (irafheader, teststring ) + * Verify that file is valid IRAF imhdr or impix + * Subroutine: irafrhead (filename, lfhead, fitsheader, lihead) + * Read IRAF image header + * Subroutine: irafrimage (fitsheader) + * Read IRAF image pixels (call after irafrhead) + * Subroutine: same_path (pixname, hdrname) + * Put filename and header path together + * Subroutine: iraf2fits (hdrname, irafheader, nbiraf, nbfits) + * Convert IRAF image header to FITS image header + * Subroutine: irafwhead (hdrname, irafheader, fitsheader) + * Write IRAF header file + * Subroutine: irafwimage (hdrname, irafheader, fitsheader, image ) + * Write IRAF image and header files + * Subroutine: fits2iraf (fitsheader, irafheader) + * Convert FITS image header to IRAF image header + * Subroutine: irafgeti4 (irafheader, offset) + * Get 4-byte integer from arbitrary part of IRAF header + * Subroutine: irafgetc2 (irafheader, offset) + * Get character string from arbitrary part of IRAF v.1 header + * Subroutine: irafgetc (irafheader, offset) + * Get character string from arbitrary part of IRAF header + * Subroutine: iraf2str (irafstring, nchar) + * Convert 2-byte/char IRAF string to 1-byte/char string + * Subroutine: str2iraf (string, irafstring, nchar) + * Convert 1-byte/char string to IRAF 2-byte/char string + * Subroutine: irafswap (bitpix,string,nbytes) + * Swap bytes in string in place, with FITS bits/pixel code + * Subroutine: irafswap2 (string,nbytes) + * Swap bytes in string in place + * Subroutine irafswap4 (string,nbytes) + * Reverse bytes of Integer*4 or Real*4 vector in place + * Subroutine irafswap8 (string,nbytes) + * Reverse bytes of Real*8 vector in place + * Subroutine irafsize (filename) + * Return length of file in bytes + * Subroutine isiraf (filename) + * Return 1 if IRAF .imh file, else 0 + + + * Copyright: 2000 Smithsonian Astrophysical Observatory + * You may do anything you like with this file except remove + * this copyright. The Smithsonian Astrophysical Observatory + * makes no representations about the suitability of this + * software for any purpose. It is provided "as is" without + * express or implied warranty. + */ + +#include <stdio.h> /* define stderr, FD, and NULL */ +#include <stdlib.h> +#include <unistd.h> +#include <fcntl.h> +#include <string.h> +#include <time.h> +#include <sys/types.h> +#include "fitsfile.h" + +/* Parameters from iraf/lib/imhdr.h for IRAF version 1 images */ +#define SZ_IMPIXFILE 79 /* name of pixel storage file */ +#define SZ_IMHDRFILE 79 /* length of header storage file */ +#define SZ_IMTITLE 79 /* image title string */ +#define LEN_IMHDR 2052 /* length of std header */ + +/* Parameters from iraf/lib/imhdr.h for IRAF version 2 images */ +#define SZ_IM2PIXFILE 255 /* name of pixel storage file */ +#define SZ_IM2HDRFILE 255 /* name of header storage file */ +#define SZ_IM2TITLE 383 /* image title string */ +#define LEN_IM2HDR 2046 /* length of std header */ + +/* Offsets into header in bytes for parameters in IRAF version 1 images */ +#define IM_HDRLEN 12 /* Length of header in 4-byte ints */ +#define IM_PIXTYPE 16 /* Datatype of the pixels */ +#define IM_NDIM 20 /* Number of dimensions */ +#define IM_LEN 24 /* Length (as stored) */ +#define IM_PHYSLEN 52 /* Physical length (as stored) */ +#define IM_PIXOFF 88 /* Offset of the pixels */ +#define IM_CTIME 108 /* Time of image creation */ +#define IM_MTIME 112 /* Time of last modification */ +#define IM_LIMTIME 116 /* Time of min,max computation */ +#define IM_MAX 120 /* Maximum pixel value */ +#define IM_MIN 124 /* Maximum pixel value */ +#define IM_PIXFILE 412 /* Name of pixel storage file */ +#define IM_HDRFILE 572 /* Name of header storage file */ +#define IM_TITLE 732 /* Image name string */ + +/* Offsets into header in bytes for parameters in IRAF version 2 images */ +#define IM2_HDRLEN 6 /* Length of header in 4-byte ints */ +#define IM2_PIXTYPE 10 /* Datatype of the pixels */ +#define IM2_SWAPPED 14 /* Pixels are byte swapped */ +#define IM2_NDIM 18 /* Number of dimensions */ +#define IM2_LEN 22 /* Length (as stored) */ +#define IM2_PHYSLEN 50 /* Physical length (as stored) */ +#define IM2_PIXOFF 86 /* Offset of the pixels */ +#define IM2_CTIME 106 /* Time of image creation */ +#define IM2_MTIME 110 /* Time of last modification */ +#define IM2_LIMTIME 114 /* Time of min,max computation */ +#define IM2_MAX 118 /* Maximum pixel value */ +#define IM2_MIN 122 /* Maximum pixel value */ +#define IM2_PIXFILE 126 /* Name of pixel storage file */ +#define IM2_HDRFILE 382 /* Name of header storage file */ +#define IM2_TITLE 638 /* Image name string */ + +/* Codes from iraf/unix/hlib/iraf.h */ +#define TY_CHAR 2 +#define TY_SHORT 3 +#define TY_INT 4 +#define TY_LONG 5 +#define TY_REAL 6 +#define TY_DOUBLE 7 +#define TY_COMPLEX 8 +#define TY_POINTER 9 +#define TY_STRUCT 10 +#define TY_USHORT 11 +#define TY_UBYTE 12 + +#define LEN_IRAFHDR 25000 +#define LEN_PIXHDR 1024 +#define LEN_FITSHDR 11520 + +int check_immagic(); +int irafgeti4(); +float irafgetr4(); +char *irafgetc2(); +char *irafgetc(); +char *iraf2str(); +static char *same_path(); +static void irafputr4(); +static void irafputi4(); +static void irafputc2(); +static void irafputc(); +static void str2iraf(); +static int headswap=-1; /* =1 to swap data bytes of foreign IRAF file */ +static void irafswap(); +static void irafswap2(); +static void irafswap4(); +static void irafswap8(); +int head_version (); +int pix_version (); +int irafncmp (); +static int machswap(); +static int irafsize(); + +#define SECONDS_1970_TO_1980 315532800L + +/* Subroutine: irafrhead + * Purpose: Open and read the iraf .imh file, translating it to FITS, too. + * Returns: NULL if failure, else pointer to IRAF .imh image header + * Notes: The imhdr format is defined in iraf/lib/imhdr.h, some of + * which defines or mimicked, above. + */ + +char * +irafrhead (filename, lihead) + +char *filename; /* Name of IRAF header file */ +int *lihead; /* Length of IRAF image header in bytes (returned) */ +{ + FILE *fd; + int nbr; + char *irafheader; + int nbhead, nbytes; + int imhver; + + headswap = -1; + *lihead = 0; + + /* open the image header file */ + fd = fopen (filename, "rb"); + if (fd == NULL) { + fprintf (stderr, "IRAFRHEAD: cannot open file %s to read\n", filename); + return (NULL); + } + + /* Find size of image header file */ + if ((nbhead = irafsize (fd)) <= 0) { + fprintf (stderr, "IRAFRHEAD: cannot read file %s, size = %d\n", + filename, nbhead); + return (NULL); + } + + /* allocate initial sized buffer */ + nbytes = nbhead + 5000; + irafheader = (char *) calloc (nbytes/4, 4); + if (irafheader == NULL) { + (void)fprintf(stderr, "IRAFRHEAD Cannot allocate %d-byte header\n", + nbytes); + return (NULL); + } + *lihead = nbytes; + + /* Read IRAF header */ + nbr = fread (irafheader, 1, nbhead, fd); + fclose (fd); + + /* Reject if header less than minimum length */ + if (nbr < LEN_PIXHDR) { + (void)fprintf(stderr, "IRAFRHEAD header file %s: %d / %d bytes read.\n", + filename,nbr,LEN_PIXHDR); + free (irafheader); + return (NULL); + } + + /* Check header magic word */ + imhver = head_version (irafheader); + if (imhver < 1) { + free (irafheader); + (void)fprintf(stderr, "IRAFRHEAD: %s is not a valid IRAF image header\n", + filename); + return(NULL); + } + + /* check number of image dimensions + if (imhver == 2) + ndim = irafgeti4 (irafheader, IM2_NDIM]) + else + ndim = irafgeti4 (irafheader, IM_NDIM]) + if (ndim < 2) { + free (irafheader); + (void)fprintf(stderr, "File %s does not contain 2d image\n", filename); + return (NULL); + } */ + + return (irafheader); +} + + +char * +irafrimage (fitsheader) + +char *fitsheader; /* FITS image header (filled) */ +{ + FILE *fd; + char *bang; + int naxis, naxis1, naxis2, naxis3, npaxis1, npaxis2,bitpix, bytepix, pixswap, i; + char *image; + int nbr, nbimage, nbaxis, nbl, nbdiff, lpname; + char *pixheader; + char *linebuff, *pixchar; + int imhver, lpixhead, len; + char pixname[SZ_IM2PIXFILE+1]; + char newpixname[SZ_IM2HDRFILE+1]; + + /* Convert pixel file name to character string */ + hgetm (fitsheader, "PIXFIL", SZ_IM2PIXFILE, pixname); + + /* Drop trailing spaces */ + lpname = strlen (pixname); + pixchar = pixname + lpname - 1; + while (*pixchar == ' ') + *pixchar = (char) 0; + + hgeti4 (fitsheader, "PIXOFF", &lpixhead); + + /* Open pixel file, ignoring machine name if present */ + if ((bang = strchr (pixname, '!')) != NULL ) + fd = fopen (bang + 1, "rb"); + else + fd = fopen (pixname, "rb"); + + /* If not at pathname in header, try same directory as header file */ + if (!fd) { + hgetm (fitsheader, "IMHFIL", SZ_IM2HDRFILE, newpixname); + len = strlen (newpixname); + newpixname[len-3] = 'p'; + newpixname[len-2] = 'i'; + newpixname[len-1] = 'x'; + fd = fopen (newpixname, "rb"); + } + + /* Print error message and exit if pixel file is not found */ + if (!fd) { + (void)fprintf(stderr, + "IRAFRIMAGE: Cannot open IRAF pixel file %s\n", pixname); + return (NULL); + } + + /* Read pixel header */ + pixheader = (char *) calloc (lpixhead/4, 4); + if (pixheader == NULL) { + (void)fprintf(stderr, "IRAFRIMAGE Cannot allocate %d-byte pixel header\n", + lpixhead); + return (NULL); + } + nbr = fread (pixheader, 1, lpixhead, fd); + + /* Check size of pixel header */ + if (nbr < lpixhead) { + (void)fprintf(stderr, "IRAF pixel file %s: %d / %d bytes read.\n", + pixname,nbr,LEN_PIXHDR); + free (pixheader); + fclose (fd); + return (NULL); + } + + /* check pixel header magic word */ + imhver = pix_version (pixheader); + if (imhver < 1) { + (void)fprintf(stderr, "File %s not valid IRAF pixel file.\n", pixname); + free (pixheader); + fclose (fd); + return(NULL); + } + free (pixheader); + + /* Find number of bytes to read */ + hgeti4 (fitsheader,"NAXIS",&naxis); + hgeti4 (fitsheader,"NAXIS1",&naxis1); + hgeti4 (fitsheader,"NAXIS2",&naxis2); + hgeti4 (fitsheader,"NPAXIS1",&npaxis1); + hgeti4 (fitsheader,"NPAXIS2",&npaxis2); + hgeti4 (fitsheader,"BITPIX",&bitpix); + if (bitpix < 0) + bytepix = -bitpix / 8; + else + bytepix = bitpix / 8; + + /* If either dimension is one and image is 3-D, read all three dimensions */ + if (naxis == 3 && ((naxis1 == 1) | (naxis2 == 1))) { + hgeti4 (fitsheader,"NAXIS3",&naxis3); + nbimage = naxis1 * naxis2 * naxis3 * bytepix; + } + else { + nbimage = naxis1 * naxis2 * bytepix; + naxis3 = 1; + } + + if (bytepix > 4) + image = (char *) calloc (nbimage/8, 8); + else if (bytepix > 2) + image = (char *) calloc (nbimage/4, 4); + else if (bytepix > 1) + image = (char *) calloc (nbimage/2, 2); + else + image = (char *) calloc (nbimage, 1); + if (image == NULL) { + (void)fprintf(stderr, "IRAFRIMAGE Cannot allocate %d-byte image buffer\n", + nbimage); + return (NULL); + } + + /* Read IRAF image all at once if physical and image dimensions are the same */ + if (npaxis1 == naxis1) + nbr = fread (image, 1, nbimage, fd); + + /* Read IRAF image one line at a time if physical and image dimensions differ */ + else { + nbdiff = (npaxis1 - naxis1) * bytepix; + nbaxis = naxis1 * bytepix; + linebuff = image; + nbr = 0; + if (naxis2 == 1 && naxis3 > 1) + naxis2 = naxis3; + for (i = 0; i < naxis2; i++) { + nbl = fread (linebuff, 1, nbaxis, fd); + nbr = nbr + nbl; + (void) fseek (fd, nbdiff, SEEK_CUR); + linebuff = linebuff + nbaxis; + } + } + fclose (fd); + + /* Check size of image */ + if (nbr < nbimage) { + (void)fprintf(stderr, "IRAF pixel file %s: %d / %d bytes read.\n", + pixname,nbr,nbimage); + free (image); + return (NULL); + } + + /* Byte-reverse image, if necessary */ + pixswap = 0; + hgetl (fitsheader, "PIXSWAP", &pixswap); + if (pixswap) + irafswap (bitpix, image, nbimage); + + return (image); +} + + +/* Return IRAF image format version number from magic word in IRAF header*/ + +int +head_version (irafheader) + +char *irafheader; /* IRAF image header from file */ + +{ + + /* Check header file magic word */ + if (irafncmp (irafheader, "imhdr", 5) != 0 ) { + if (strncmp (irafheader, "imhv2", 5) != 0) + return (0); + else + return (2); + } + else + return (1); +} + + +/* Return IRAF image format version number from magic word in IRAF pixel file */ + +int +pix_version (irafheader) + +char *irafheader; /* IRAF image header from file */ + +{ + + /* Check pixel file header magic word */ + if (irafncmp (irafheader, "impix", 5) != 0) { + if (strncmp (irafheader, "impv2", 5) != 0) + return (0); + else + return (2); + } + else + return (1); +} + + +/* Verify that file is valid IRAF imhdr or impix by checking first 5 chars + * Returns: 0 on success, 1 on failure */ + +int +irafncmp (irafheader, teststring, nc) + +char *irafheader; /* IRAF image header from file */ +char *teststring; /* C character string to compare */ +int nc; /* Number of characters to compate */ + +{ + char *line; + + headswap = -1; + if ((line = iraf2str (irafheader, nc)) == NULL) + return (1); + if (strncmp (line, teststring, nc) == 0) { + free (line); + return (0); + } + else { + free (line); + return (1); + } +} + +/* Convert IRAF image header to FITS image header, returning FITS header */ + +char * +iraf2fits (hdrname, irafheader, nbiraf, nbfits) + +char *hdrname; /* IRAF header file name (may be path) */ +char *irafheader; /* IRAF image header */ +int nbiraf; /* Number of bytes in IRAF header */ +int *nbfits; /* Number of bytes in FITS header (returned) */ + +{ + char *objname; /* object name from FITS file */ + int lstr, i, j, k, ib, nax, nbits, nl; + int lname = 0; + char *pixname, *newpixname, *bang, *chead; + char *fitsheader; + int nblock, nlines; + char *fhead, *fhead1, *fp, endline[81]; + char irafchar; + char fitsline[81]; + char *dstring; + int pixtype; + int imhver, n, imu, pixoff, impixoff, immax, immin, imtime; + int imndim, imlen, imphyslen, impixtype, pixswap, hpixswap, mtime; + float rmax, rmin; + + headswap = -1; + + /* Set up last line of FITS header */ + (void)strncpy (endline,"END", 3); + for (i = 3; i < 80; i++) + endline[i] = ' '; + endline[80] = 0; + + /* Check header magic word */ + imhver = head_version (irafheader); + if (imhver < 1) { + (void)fprintf(stderr, "File %s not valid IRAF image header\n", + hdrname); + return(NULL); + } + if (imhver == 2) { + nlines = 24 + ((nbiraf - LEN_IM2HDR) / 81); + imndim = IM2_NDIM; + imlen = IM2_LEN; + imphyslen = IM2_PHYSLEN; + impixtype = IM2_PIXTYPE; + impixoff = IM2_PIXOFF; + imtime = IM2_MTIME; + immax = IM2_MAX; + immin = IM2_MIN; + } + else { + nlines = 24 + ((nbiraf - LEN_IMHDR) / 162); + imndim = IM_NDIM; + imlen = IM_LEN; + imphyslen = IM_PHYSLEN; + impixtype = IM_PIXTYPE; + impixoff = IM_PIXOFF; + imtime = IM_MTIME; + immax = IM_MAX; + immin = IM_MIN; + } + + /* Initialize FITS header */ + nblock = (nlines * 80) / 2880; + *nbfits = (nblock + 5) * 2880 + 4; + fitsheader = (char *) calloc (*nbfits, 1); + if (fitsheader == NULL) { + (void)fprintf(stderr, "IRAF2FITS Cannot allocate %d-byte FITS header\n", + *nbfits); + return (NULL); + } + hlength (fitsheader, *nbfits); + fhead = fitsheader; + (void)strncpy (fitsheader, endline, 80); + hputl (fitsheader, "SIMPLE", 1); + fhead = fhead + 80; + + /* Set pixel size in FITS header */ + pixtype = irafgeti4 (irafheader, impixtype); + switch (pixtype) { + case TY_CHAR: + nbits = 8; + break; + case TY_UBYTE: + nbits = 8; + break; + case TY_SHORT: + nbits = 16; + break; + case TY_USHORT: + nbits = -16; + break; + case TY_INT: + case TY_LONG: + nbits = 32; + break; + case TY_REAL: + nbits = -32; + break; + case TY_DOUBLE: + nbits = -64; + break; + default: + (void)fprintf(stderr,"Unsupported data type: %d\n", pixtype); + return (NULL); + } + hputi4 (fitsheader,"BITPIX",nbits); + hputcom (fitsheader,"BITPIX", "IRAF .imh pixel type"); + fhead = fhead + 80; + + /* Set image dimensions in FITS header */ + nax = irafgeti4 (irafheader, imndim); + hputi4 (fitsheader,"NAXIS",nax); + hputcom (fitsheader,"NAXIS", "IRAF .imh naxis"); + fhead = fhead + 80; + + n = irafgeti4 (irafheader, imlen); + hputi4 (fitsheader, "NAXIS1", n); + hputcom (fitsheader,"NAXIS1", "IRAF .imh image naxis[1]"); + fhead = fhead + 80; + + if (nax > 1) { + n = irafgeti4 (irafheader, imlen+4); + hputi4 (fitsheader, "NAXIS2", n); + hputcom (fitsheader,"NAXIS2", "IRAF .imh image naxis[2]"); + } + else + hputi4 (fitsheader, "NAXIS2", 1); + hputcom (fitsheader,"NAXIS2", "IRAF .imh naxis[2]"); + fhead = fhead + 80; + + if (nax > 2) { + n = irafgeti4 (irafheader, imlen+8); + hputi4 (fitsheader, "NAXIS3", n); + hputcom (fitsheader,"NAXIS3", "IRAF .imh image naxis[3]"); + fhead = fhead + 80; + } + if (nax > 3) { + n = irafgeti4 (irafheader, imlen+12); + hputi4 (fitsheader, "NAXIS4", n); + hputcom (fitsheader,"NAXIS4", "IRAF .imh image naxis[4]"); + fhead = fhead + 80; + } + + /* Set object name in FITS header */ + if (imhver == 2) + objname = irafgetc (irafheader, IM2_TITLE, SZ_IM2TITLE); + else + objname = irafgetc2 (irafheader, IM_TITLE, SZ_IMTITLE); + if ((lstr = strlen (objname)) < 8) { + for (i = lstr; i < 8; i++) + objname[i] = ' '; + objname[8] = 0; + } + hputs (fitsheader,"OBJECT",objname); + hputcom (fitsheader,"OBJECT", "IRAF .imh title"); + free (objname); + fhead = fhead + 80; + + /* Save physical axis lengths so image file can be read */ + n = irafgeti4 (irafheader, imphyslen); + hputi4 (fitsheader, "NPAXIS1", n); + hputcom (fitsheader,"NPAXIS1", "IRAF .imh physical naxis[1]"); + fhead = fhead + 80; + if (nax > 1) { + n = irafgeti4 (irafheader, imphyslen+4); + hputi4 (fitsheader, "NPAXIS2", n); + hputcom (fitsheader,"NPAXIS2", "IRAF .imh physical naxis[2]"); + fhead = fhead + 80; + } + if (nax > 2) { + n = irafgeti4 (irafheader, imphyslen+8); + hputi4 (fitsheader, "NPAXIS3", n); + hputcom (fitsheader,"NPAXIS3", "IRAF .imh physical naxis[3]"); + fhead = fhead + 80; + } + if (nax > 3) { + n = irafgeti4 (irafheader, imphyslen+12); + hputi4 (fitsheader, "NPAXIS4", n); + hputcom (fitsheader,"NPAXIS4", "IRAF .imh physical naxis[4]"); + fhead = fhead + 80; + } + + /* Save image minimum and maximum in header */ + rmax = irafgetr4 (irafheader, immax); + rmin = irafgetr4 (irafheader, immin); + if (rmin != rmax) { + hputr4 (fitsheader, "IRAFMIN", &rmin); + fhead = fhead + 80; + hputcom (fitsheader,"IRAFMIN", "IRAF .imh minimum"); + hputr4 (fitsheader, "IRAFMAX", &rmax); + hputcom (fitsheader,"IRAFMAX", "IRAF .imh maximum"); + fhead = fhead + 80; + } + + /* Save image header filename in header */ + nl = hputm (fitsheader,"IMHFIL",hdrname); + if (nl > 0) { + lname = strlen (hdrname); + strcpy (fitsline, "IRAF header file name"); + if (lname < 43) + hputcom (fitsheader,"IMHFIL_1", fitsline); + else if (lname > 67 && lname < 110) + hputcom (fitsheader,"IMHFIL_2", fitsline); + else if (lname > 134 && lname < 177) + hputcom (fitsheader,"IMHFIL_3", fitsline); + } + if (nl > 0) fhead = fhead + (nl * 80); + + /* Save image pixel file pathname in header */ + if (imhver == 2) + pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE); + else + pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE); + if (strncmp(pixname, "HDR", 3) == 0 ) { + newpixname = same_path (pixname, hdrname); + free (pixname); + pixname = newpixname; + } + if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) { + newpixname = same_path (pixname, hdrname); + free (pixname); + pixname = newpixname; + } + + if ((bang = strchr (pixname, '!')) != NULL ) + nl = hputm (fitsheader,"PIXFIL",bang+1); + else + nl = hputm (fitsheader,"PIXFIL",pixname); + free (pixname); + if (nl > 0) { + strcpy (fitsline, "IRAF .pix pixel file"); + if (lname < 43) + hputcom (fitsheader,"PIXFIL_1", fitsline); + else if (lname > 67 && lname < 110) + hputcom (fitsheader,"PIXFIL_2", fitsline); + else if (lname > 134 && lname < 177) + hputcom (fitsheader,"PIXFIL_3", fitsline); + } + if (nl > 0) fhead = fhead + (nl * 80); + + /* Save image offset from star of pixel file */ + pixoff = irafgeti4 (irafheader, impixoff); + pixoff = (pixoff - 1) * 2; + hputi4 (fitsheader, "PIXOFF", pixoff); + hputcom (fitsheader,"PIXOFF", "IRAF .pix pixel offset (Do not change!)"); + fhead = fhead + 80; + + /* Save IRAF file format version in header */ + hputi4 (fitsheader,"IMHVER",imhver); + hputcom (fitsheader,"IMHVER", "IRAF .imh format version (1 or 2)"); + fhead = fhead + 80; + + /* Set flag if header numbers are byte-reversed on this machine */ + if (machswap() != headswap) + hputl (fitsheader, "HEADSWAP", 1); + else + hputl (fitsheader, "HEADSWAP", 0); + hputcom (fitsheader,"HEADSWAP", "IRAF header, FITS byte orders differ if T"); + fhead = fhead + 80; + + /* Set flag if image pixels are byte-reversed on this machine */ + if (imhver == 2) { + hpixswap = irafgeti4 (irafheader, IM2_SWAPPED); + if (headswap && !hpixswap) + pixswap = 1; + else if (!headswap && hpixswap) + pixswap = 1; + else + pixswap = 0; + } + else + pixswap = headswap; + if (machswap() != pixswap) + hputl (fitsheader, "PIXSWAP", 1); + else + hputl (fitsheader, "PIXSWAP", 0); + hputcom (fitsheader,"PIXSWAP", "IRAF pixels, FITS byte orders differ if T"); + fhead = fhead + 80; + + /* Read modification time */ + mtime = irafgeti4 (irafheader, imtime); + if (mtime == 0) + dstring = lt2fd (); + else + dstring = tsi2fd (mtime); + hputs (fitsheader, "DATE-MOD", dstring); + hputcom (fitsheader,"DATE-MOD", "Date of latest file modification"); + free (dstring); + fhead = fhead + 80; + + /* Add user portion of IRAF header to FITS header */ + fitsline[80] = 0; + if (imhver == 2) { + imu = LEN_IM2HDR; + chead = irafheader; + j = 0; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + for (i = imu; i < nbiraf; i++) { + irafchar = chead[i]; + if (irafchar == 0) + break; + else if (irafchar == 10) { + (void)strncpy (fhead, fitsline, 80); + /* fprintf (stderr,"%80s\n",fitsline); */ + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + fhead = fhead + 80; + } + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + j = 0; + } + else { + if (j > 80) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + /* fprintf (stderr,"%80s\n",fitsline); */ + j = 9; + fhead = fhead + 80; + } + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + if (irafchar > 32 && irafchar < 127) + fitsline[j] = irafchar; + j++; + } + } + } + else { + imu = LEN_IMHDR; + chead = irafheader; + if (headswap == 1) + ib = 0; + else + ib = 1; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + j = 0; + for (i = imu; i < nbiraf; i=i+2) { + irafchar = chead[i+ib]; + if (irafchar == 0) + break; + else if (irafchar == 10) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + fhead = fhead + 80; + } + /* fprintf (stderr,"%80s\n",fitsline); */ + j = 0; + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + else { + if (j > 80) { + if (strncmp (fitsline, "OBJECT ", 7) != 0) { + (void)strncpy (fhead, fitsline, 80); + j = 9; + fhead = fhead + 80; + } + /* fprintf (stderr,"%80s\n",fitsline); */ + for (k = 0; k < 80; k++) + fitsline[k] = ' '; + } + if (irafchar > 32 && irafchar < 127) + fitsline[j] = irafchar; + j++; + } + } + } + + /* Add END to last line */ + (void)strncpy (fhead, endline, 80); + + /* Find end of last 2880-byte block of header */ + fhead = ksearch (fitsheader, "END") + 80; + nblock = *nbfits / 2880; + fhead1 = fitsheader + (nblock * 2880); + + /* Pad rest of header with spaces */ + strncpy (endline," ",3); + for (fp = fhead; fp < fhead1; fp = fp + 80) { + (void)strncpy (fp, endline,80); + } + + return (fitsheader); +} + + +int +irafwhead (hdrname, lhead, irafheader, fitsheader) + +char *hdrname; /* Name of IRAF header file */ +int lhead; /* Length of IRAF header */ +char *irafheader; /* IRAF header */ +char *fitsheader; /* FITS image header */ + +{ + int fd; + int nbw, nbhead, lphead, pixswap; + + /* Get rid of redundant header information */ + hgeti4 (fitsheader, "PIXOFF", &lphead); + hgeti4 (fitsheader, "PIXSWAP", &pixswap); + + /* Write IRAF header file */ + + /* Convert FITS header to IRAF header */ + irafheader = fits2iraf (fitsheader, irafheader, lhead, &nbhead); + if (irafheader == NULL) { + fprintf (stderr, "IRAFWIMAGE: file %s header error\n", hdrname); + return (-1); + } + + /* Open the output file */ + if (!access (hdrname, 0)) { + fd = open (hdrname, O_WRONLY); + if (fd < 3) { + fprintf (stderr, "IRAFWIMAGE: file %s not writeable\n", hdrname); + return (0); + } + } + else { + fd = open (hdrname, O_RDWR+O_CREAT, 0666); + if (fd < 3) { + fprintf (stderr, "IRAFWIMAGE: cannot create file %s\n", hdrname); + return (0); + } + } + + /* Write IRAF header to disk file */ + nbw = write (fd, irafheader, nbhead); + (void) ftruncate (fd, nbhead); + close (fd); + if (nbw < nbhead) { + (void)fprintf(stderr, "IRAF header file %s: %d / %d bytes written.\n", + hdrname, nbw, nbhead); + return (-1); + } + + return (nbw); +} + +/* IRAFWIMAGE -- write IRAF .imh header file and .pix image file + * No matter what the input, this always writes in the local byte order */ + +int +irafwimage (hdrname, lhead, irafheader, fitsheader, image ) + +char *hdrname; /* Name of IRAF header file */ +int lhead; /* Length of IRAF header */ +char *irafheader; /* IRAF header */ +char *fitsheader; /* FITS image header */ +char *image; /* IRAF image */ + +{ + int fd; + char *bang; + int nbw, bytepix, bitpix, naxis, naxis1, naxis2, nbimage, lphead; + char *pixn, *newpixname; + char pixname[SZ_IM2PIXFILE+1]; + int imhver, pixswap; + + hgeti4 (fitsheader, "IMHVER", &imhver); + + if (!hgetm (fitsheader, "PIXFIL", SZ_IM2PIXFILE, pixname)) { + if (imhver == 2) + pixn = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE); + else + pixn = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE); + if (strncmp(pixn, "HDR", 3) == 0 ) { + newpixname = same_path (pixn, hdrname); + strcpy (pixname, newpixname); + free (newpixname); + } + else { + if ((bang = strchr (pixn, '!')) != NULL ) + strcpy (pixname, bang+1); + else + strcpy (pixname, pixn); + } + free (pixn); + } + + /* Find number of bytes to write */ + hgeti4 (fitsheader,"NAXIS",&naxis); + hgeti4 (fitsheader,"NAXIS1",&naxis1); + hgeti4 (fitsheader,"NAXIS2",&naxis2); + hgeti4 (fitsheader,"BITPIX",&bitpix); + if (bitpix < 0) + bytepix = -bitpix / 8; + else + bytepix = bitpix / 8; + + /* If either dimension is one and image is 3-D, read all three dimensions */ + if (naxis == 3 && ((naxis1 == 1) | (naxis2 == 1))) { + int naxis3; + hgeti4 (fitsheader,"NAXIS3",&naxis3); + nbimage = naxis1 * naxis2 * naxis3 * bytepix; + } + else + nbimage = naxis1 * naxis2 * bytepix; + + /* Read information about pixel file from header */ + hgeti4 (fitsheader, "PIXOFF", &lphead); + hgeti4 (fitsheader, "PIXSWAP", &pixswap); + + /* Write IRAF header file */ + if (irafwhead (hdrname, lhead, irafheader, fitsheader)) + return (0); + + /* Open the output file */ + if (!access (pixname, 0)) { + fd = open (pixname, O_WRONLY); + if (fd < 3) { + fprintf (stderr, "IRAFWIMAGE: file %s not writeable\n", pixname); + return (0); + } + } + else { + fd = open (pixname, O_RDWR+O_CREAT, 0666); + if (fd < 3) { + fprintf (stderr, "IRAFWIMAGE: cannot create file %s\n", pixname); + return (0); + } + } + + /* Write header to IRAF pixel file */ + if (imhver == 2) + irafputc ("impv2", irafheader, 0, 5); + else + irafputc2 ("impix", irafheader, 0, 5); + nbw = write (fd, irafheader, lphead); + + /* Byte-reverse image, if necessary */ + if (pixswap) + irafswap (bitpix, image, nbimage); + + /* Write data to IRAF pixel file */ + nbw = write (fd, image, nbimage); + close (fd); + + return (nbw); +} + + +/* Put filename and header path together */ + +static char * +same_path (pixname, hdrname) + +char *pixname; /* IRAF pixel file pathname */ +char *hdrname; /* IRAF image header file pathname */ + +{ + int len, plen; + char *newpixname; + + newpixname = (char *) calloc (SZ_IM2PIXFILE, 1); + + /* Pixel file is in same directory as header */ + if (strncmp(pixname, "HDR$", 4) == 0 ) { + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + + /* find the end of the pathname */ + len = strlen (newpixname); +#ifndef VMS + while( (len > 0) && (newpixname[len-1] != '/') ) +#else + while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') ) +#endif + len--; + + /* add name */ + newpixname[len] = '\0'; + plen = strlen (pixname) - 4; + if (len + plen > SZ_IM2PIXFILE) + (void)strncat (newpixname, &pixname[4], SZ_IM2PIXFILE - len); + else + (void)strncat (newpixname, &pixname[4], plen); + } + + /* Bare pixel file with no path is assumed to be same as HDR$filename */ + else if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) { + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + + /* find the end of the pathname */ + len = strlen (newpixname); +#ifndef VMS + while( (len > 0) && (newpixname[len-1] != '/') ) +#else + while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') ) +#endif + len--; + + /* add name */ + newpixname[len] = '\0'; + (void)strncat (newpixname, pixname, SZ_IM2PIXFILE); + } + + /* Pixel file has same name as header file, but with .pix extension */ + else if (strncmp (pixname, "HDR", 3) == 0) { + + /* load entire header name string into name buffer */ + (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE); + len = strlen (newpixname); + newpixname[len-3] = 'p'; + newpixname[len-2] = 'i'; + newpixname[len-1] = 'x'; + } + + return (newpixname); +} + +/* Convert FITS image header to IRAF image header, returning IRAF header */ +/* No matter what the input, this always writes in the local byte order */ + +char * +fits2iraf (fitsheader, irafheader, nbhead, nbiraf) + +char *fitsheader; /* FITS image header */ +char *irafheader; /* IRAF image header (returned updated) */ +int nbhead; /* Length of IRAF header */ +int *nbiraf; /* Length of returned IRAF header */ + +{ + int i, n, pixoff, lhdrdir; + short *irafp, *irafs, *irafu; + char *iraf2u, *iraf2p, *filename, *hdrdir; + char *fitsend, *fitsp, pixfile[SZ_IM2PIXFILE], hdrfile[SZ_IM2HDRFILE]; + char title[SZ_IM2TITLE], temp[80]; + int nax, nlfits, imhver, nbits, pixtype, hdrlength, mtime; + int imndim, imlen, imphyslen, impixtype, imhlen, imtime, immax, immin; + float rmax, rmin; + + hgeti4 (fitsheader, "IMHVER", &imhver); + hdel (fitsheader, "IMHVER"); + hdel (fitsheader, "IMHVER"); + hgetl (fitsheader, "HEADSWAP", &headswap); + hdel (fitsheader, "HEADSWAP"); + hdel (fitsheader, "HEADSWAP"); + if (imhver == 2) { + imhlen = IM2_HDRLEN; + imndim = IM2_NDIM; + imlen = IM2_LEN; + imtime = IM2_MTIME; + imphyslen = IM2_PHYSLEN; + impixtype = IM2_PIXTYPE; + immax = IM2_MAX; + immin = IM2_MIN; + } + else { + imhlen = IM_HDRLEN; + imndim = IM_NDIM; + imlen = IM_LEN; + imtime = IM_MTIME; + imphyslen = IM_PHYSLEN; + impixtype = IM_PIXTYPE; + immax = IM_MAX; + immin = IM_MIN; + } + + /* Delete FITS header keyword not needed by IRAF */ + hdel (fitsheader,"SIMPLE"); + + /* Set IRAF image data type */ + hgeti4 (fitsheader,"BITPIX", &nbits); + switch (nbits) { + case 8: + pixtype = TY_CHAR; + break; + case -8: + pixtype = TY_UBYTE; + break; + case 16: + pixtype = TY_SHORT; + break; + case -16: + pixtype = TY_USHORT; + break; + case 32: + pixtype = TY_INT; + break; + case -32: + pixtype = TY_REAL; + break; + case -64: + pixtype = TY_DOUBLE; + break; + default: + (void)fprintf(stderr,"Unsupported data type: %d\n", nbits); + return (NULL); + } + irafputi4 (irafheader, impixtype, pixtype); + hdel (fitsheader,"BITPIX"); + + /* Set IRAF image dimensions */ + hgeti4 (fitsheader,"NAXIS",&nax); + irafputi4 (irafheader, imndim, nax); + hdel (fitsheader,"NAXIS"); + + hgeti4 (fitsheader, "NAXIS1", &n); + irafputi4 (irafheader, imlen, n); + irafputi4 (irafheader, imphyslen, n); + hdel (fitsheader,"NAXIS1"); + + hgeti4 (fitsheader,"NAXIS2",&n); + irafputi4 (irafheader, imlen+4, n); + irafputi4 (irafheader, imphyslen+4, n); + hdel (fitsheader,"NAXIS2"); + + if (nax > 2) { + hgeti4 (fitsheader,"NAXIS3",&n); + irafputi4 (irafheader, imlen+8, n); + irafputi4 (irafheader, imphyslen+8, n); + hdel (fitsheader,"NAXIS3"); + } + + if (nax > 3) { + hgeti4 (fitsheader,"NAXIS4",&n); + irafputi4 (irafheader, imlen+12, n); + irafputi4 (irafheader, imphyslen+12, n); + hdel (fitsheader,"NAXIS4"); + } + + /* Set image pixel value limits */ + rmin = 0.0; + hgetr4 (fitsheader, "IRAFMIN", &rmin); + rmax = 0.0; + hgetr4 (fitsheader, "IRAFMAX", &rmax); + if (rmin != rmax) { + irafputr4 (irafheader, immax, rmax); + irafputr4 (irafheader, immin, rmin); + } + hdel (fitsheader, "IRAFMIN"); + hdel (fitsheader, "IRAFMAX"); + + /* Replace pixel file name, if it is in the FITS header */ + if (hgetm (fitsheader, "PIXFIL", SZ_IM2PIXFILE, pixfile)) { + if (strchr (pixfile, '/')) { + if (hgetm (fitsheader, "IMHFIL", SZ_IM2HDRFILE, hdrfile)) { + hdrdir = strrchr (hdrfile, '/'); + if (hdrdir != NULL) { + lhdrdir = hdrdir - hdrfile + 1; + if (!strncmp (pixfile, hdrfile, lhdrdir)) { + filename = pixfile + lhdrdir; + strcpy (temp, "HDR$"); + strcat (temp,filename); + strcpy (pixfile, temp); + } + } + if (pixfile[0] != '/' && pixfile[0] != 'H') { + strcpy (temp, "HDR$"); + strcat (temp,pixfile); + strcpy (pixfile, temp); + } + } + } + + if (imhver == 2) + irafputc (pixfile, irafheader, IM2_PIXFILE, SZ_IM2PIXFILE); + else + irafputc2 (pixfile, irafheader, IM_PIXFILE, SZ_IMPIXFILE); + hdel (fitsheader,"PIXFIL_1"); + hdel (fitsheader,"PIXFIL_2"); + hdel (fitsheader,"PIXFIL_3"); + hdel (fitsheader,"PIXFIL_4"); + } + + /* Replace header file name, if it is in the FITS header */ + if (hgetm (fitsheader, "IMHFIL", SZ_IM2HDRFILE, pixfile)) { + if (!strchr (pixfile,'/') && !strchr (pixfile,'$')) { + strcpy (temp, "HDR$"); + strcat (temp,pixfile); + strcpy (pixfile, temp); + } + if (imhver == 2) + irafputc (pixfile, irafheader, IM2_HDRFILE, SZ_IM2HDRFILE); + else + irafputc2 (pixfile, irafheader, IM_HDRFILE, SZ_IMHDRFILE); + hdel (fitsheader, "IMHFIL_1"); + hdel (fitsheader, "IMHFIL_2"); + hdel (fitsheader, "IMHFIL_3"); + hdel (fitsheader, "IMHFIL_4"); + } + + /* Replace image title, if it is in the FITS header */ + if (hgets (fitsheader, "OBJECT", SZ_IM2TITLE, title)) { + if (imhver == 2) + irafputc (title, irafheader, IM2_TITLE, SZ_IM2TITLE); + else + irafputc2 (title, irafheader, IM_TITLE, SZ_IMTITLE); + hdel (fitsheader, "OBJECT"); + } + hgeti4 (fitsheader, "PIXOFF", &pixoff); + hdel (fitsheader, "PIXOFF"); + hdel (fitsheader, "PIXOFF"); + hdel (fitsheader, "PIXSWAP"); + hdel (fitsheader, "PIXSWAP"); + hdel (fitsheader, "DATE-MOD"); + hdel (fitsheader, "DATE-MOD"); + fitsend = ksearch (fitsheader,"END"); + + /* Find length of FITS header */ + fitsend = ksearch (fitsheader,"END"); + nlfits = ((fitsend - fitsheader) / 80); + + /* Find new length of IRAF header */ + if (imhver == 2) + *nbiraf = LEN_IM2HDR + (81 * nlfits); + else + *nbiraf = LEN_IMHDR + (162 * nlfits); + if (*nbiraf > nbhead) + irafheader = realloc (irafheader, *nbiraf); + + /* Reset modification time */ + mtime = lt2tsi (); + irafputi4 (irafheader, imtime, mtime); + + /* Replace user portion of IRAF header with remaining FITS header */ + if (imhver == 2) { + iraf2u = irafheader + LEN_IM2HDR; + iraf2p = iraf2u; + for (fitsp = fitsheader; fitsp < fitsend; fitsp = fitsp + 80) { + for (i = 0; i < 80; i++) + *iraf2p++ = fitsp[i]; + *iraf2p++ = 10; + } + *iraf2p++ = 0; + *nbiraf = iraf2p - irafheader; + hdrlength = 1 + *nbiraf / 2; + } + else { + irafs = (short *)irafheader; + irafu = irafs + (LEN_IMHDR / 2); + irafp = irafu; + for (fitsp = fitsheader; fitsp < fitsend; fitsp = fitsp + 80) { + for (i = 0; i < 80; i++) + *irafp++ = (short) fitsp[i]; + *irafp++ = 10; + } + *irafp++ = 0; + *irafp++ = 32; + *nbiraf = 2 * (irafp - irafs); + hdrlength = *nbiraf / 4; + } + + /* Length of header file */ + irafputi4 (irafheader, imhlen, hdrlength); + + /* Offset in .pix file to first pixel data + hputi4 (fitsheader, "PIXOFF", pixoff); */ + + /* Return number of bytes in new IRAF header */ + return (irafheader); +} + + +int +irafgeti4 (irafheader, offset) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before number */ + +{ + char *ctemp, *cheader; + int temp; + + cheader = irafheader; + ctemp = (char *) &temp; + + /* If header swap flag not set, set it now */ + if (headswap < 0) { + if (cheader[offset] > 0) + headswap = 1; + else + headswap = 0; + } + + if (machswap() != headswap) { + ctemp[3] = cheader[offset]; + ctemp[2] = cheader[offset+1]; + ctemp[1] = cheader[offset+2]; + ctemp[0] = cheader[offset+3]; + } + else { + ctemp[0] = cheader[offset]; + ctemp[1] = cheader[offset+1]; + ctemp[2] = cheader[offset+2]; + ctemp[3] = cheader[offset+3]; + } + return (temp); +} + + +float +irafgetr4 (irafheader, offset) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before number */ + +{ + char *ctemp, *cheader; + float temp; + + cheader = irafheader; + ctemp = (char *) &temp; + + /* If header swap flag not set, set it now */ + if (headswap < 0) { + if (cheader[offset] > 0) + headswap = 1; + else + headswap = 0; + } + + if (machswap() != headswap) { + ctemp[3] = cheader[offset]; + ctemp[2] = cheader[offset+1]; + ctemp[1] = cheader[offset+2]; + ctemp[0] = cheader[offset+3]; + } + else { + ctemp[0] = cheader[offset]; + ctemp[1] = cheader[offset+1]; + ctemp[2] = cheader[offset+2]; + ctemp[3] = cheader[offset+3]; + } + return (temp); +} + + +/* IRAFGETC2 -- Get character string from arbitrary part of v.1 IRAF header */ + +char * +irafgetc2 (irafheader, offset, nc) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before string */ +int nc; /* Maximum number of characters in string */ + +{ + char *irafstring, *string; + + irafstring = irafgetc (irafheader, offset, 2*(nc+1)); + string = iraf2str (irafstring, nc); + free (irafstring); + + return (string); +} + + +/* IRAFGETC -- Get character string from arbitrary part of IRAF header */ + +char * +irafgetc (irafheader, offset, nc) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before string */ +int nc; /* Maximum number of characters in string */ + +{ + char *ctemp, *cheader; + int i; + + cheader = irafheader; + ctemp = (char *) calloc (nc+1, 1); + if (ctemp == NULL) { + (void)fprintf(stderr, "IRAFGETC Cannot allocate %d-byte variable\n", + nc+1); + return (NULL); + } + for (i = 0; i < nc; i++) { + ctemp[i] = cheader[offset+i]; + if (ctemp[i] > 0 && ctemp[i] < 32) + ctemp[i] = ' '; + } + + return (ctemp); +} + + +/* Convert IRAF 2-byte/char string to 1-byte/char string */ + +char * +iraf2str (irafstring, nchar) + +char *irafstring; /* IRAF 2-byte/character string */ +int nchar; /* Number of characters in string */ +{ + char *string; + int i, j; + + /* Set swap flag according to position of nulls in 2-byte characters */ + if (headswap < 0) { + if (irafstring[0] != 0 && irafstring[1] == 0) + headswap = 1; + else if (irafstring[0] == 0 && irafstring[1] != 0) + headswap = 0; + else + return (NULL); + } + + string = (char *) calloc (nchar+1, 1); + if (string == NULL) { + (void)fprintf(stderr, "IRAF2STR Cannot allocate %d-byte variable\n", + nchar+1); + return (NULL); + } + + /* Swap bytes, if requested */ + if (headswap) + j = 0; + else + j = 1; + + /* Convert appropriate byte of input to output character */ + for (i = 0; i < nchar; i++) { + string[i] = irafstring[j]; + j = j + 2; + } + + return (string); +} + + +/* IRAFPUTI4 -- Insert 4-byte integer into arbitrary part of IRAF header */ + +static void +irafputi4 (irafheader, offset, inum) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before number */ +int inum; /* Number to put into header */ + +{ + char *cn, *chead; + + chead = irafheader; + cn = (char *) &inum; + if (headswap < 0) + headswap = 0; + if (headswap != machswap()) { + chead[offset+3] = cn[0]; + chead[offset+2] = cn[1]; + chead[offset+1] = cn[2]; + chead[offset] = cn[3]; + } + else { + chead[offset] = cn[0]; + chead[offset+1] = cn[1]; + chead[offset+2] = cn[2]; + chead[offset+3] = cn[3]; + } + return; +} + + +/* IRAFPUTR4 -- Insert 4-byte real number into arbitrary part of IRAF header */ + +static void +irafputr4 (irafheader, offset, rnum) + +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before number */ +float rnum; /* Number to put into header */ + +{ + char *cn, *chead; + + chead = irafheader; + cn = (char *) &rnum; + if (headswap < 0) + headswap = 0; + if (headswap != machswap()) { + chead[offset+3] = cn[0]; + chead[offset+2] = cn[1]; + chead[offset+1] = cn[2]; + chead[offset] = cn[3]; + } + else { + chead[offset] = cn[0]; + chead[offset+1] = cn[1]; + chead[offset+2] = cn[2]; + chead[offset+3] = cn[3]; + } + return; +} + + +/* IRAFPUTC2 -- Insert character string into arbitrary part of v.1 IRAF header */ + +static void +irafputc2 (string, irafheader, offset, nc) + +char *string; /* String to insert into header */ +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before string */ +int nc; /* Maximum number of characters in string */ + +{ + char *irafstring; + + irafstring = (char *) calloc (2 * nc, 1); + if (irafstring == NULL) { + (void)fprintf(stderr, "IRAFPUTC2 Cannot allocate %d-byte variable\n", + 2 * nc); + } + str2iraf (string, irafstring, nc); + irafputc (irafstring, irafheader, offset, 2*nc); + + return; +} + + +/* IRAFPUTC -- Insert character string into arbitrary part of IRAF header */ + +static void +irafputc (string, irafheader, offset, nc) + +char *string; /* String to insert into header */ +char *irafheader; /* IRAF image header */ +int offset; /* Number of bytes to skip before string */ +int nc; /* Maximum number of characters in string */ + +{ + char *chead; + int i; + + chead = irafheader; + for (i = 0; i < nc; i++) + chead[offset+i] = string[i]; + + return; +} + + +/* STR2IRAF -- Convert 1-byte/char string to IRAF 2-byte/char string */ + +static void +str2iraf (string, irafstring, nchar) + +char *string; /* 1-byte/character string */ +char *irafstring; /* IRAF 2-byte/character string */ +int nchar; /* Maximum number of characters in IRAF string */ +{ + int i, j, nc, nbytes; + + nc = strlen (string); + + /* Fill output string with zeroes */ + nbytes = nchar * 2; + for (i = 0; i < nbytes; i++) + irafstring[i] = 0; + + /* If swapped, start with first byte of 2-byte characters */ + if (headswap) + j = 0; + else + j = 1; + + /* Move input characters to appropriate bytes of output */ + for (i = 0; i < nchar; i++) { + if (i > nc) + irafstring[j] = 0; + else + irafstring[j] = string[i]; + j = j + 2; + } + + return; +} + + +/* IRAFSWAP -- Reverse bytes of any type of vector in place */ + +static void +irafswap (bitpix, string, nbytes) + +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +char *string; /* Address of starting point of bytes to swap */ +int nbytes; /* Number of bytes to swap */ + +{ + switch (bitpix) { + + case 16: + if (nbytes < 2) return; + irafswap2 (string,nbytes); + break; + + case 32: + if (nbytes < 4) return; + irafswap4 (string,nbytes); + break; + + case -16: + if (nbytes < 2) return; + irafswap2 (string,nbytes); + break; + + case -32: + if (nbytes < 4) return; + irafswap4 (string,nbytes); + break; + + case -64: + if (nbytes < 8) return; + irafswap8 (string,nbytes); + break; + + } + return; +} + + +/* IRAFSWAP2 -- Swap bytes in string in place */ + +static void +irafswap2 (string,nbytes) + + +char *string; /* Address of starting point of bytes to swap */ +int nbytes; /* Number of bytes to swap */ + +{ + char *sbyte, temp, *slast; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp = sbyte[0]; + sbyte[0] = sbyte[1]; + sbyte[1] = temp; + sbyte= sbyte + 2; + } + return; +} + + +/* IRAFSWAP4 -- Reverse bytes of Integer*4 or Real*4 vector in place */ + +static void +irafswap4 (string,nbytes) + +char *string; /* Address of Integer*4 or Real*4 vector */ +int nbytes; /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp0, temp1, temp2, temp3; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp3 = sbyte[0]; + temp2 = sbyte[1]; + temp1 = sbyte[2]; + temp0 = sbyte[3]; + sbyte[0] = temp0; + sbyte[1] = temp1; + sbyte[2] = temp2; + sbyte[3] = temp3; + sbyte = sbyte + 4; + } + + return; +} + + +/* IRAFSWAP8 -- Reverse bytes of Real*8 vector in place */ + +static void +irafswap8 (string,nbytes) + +char *string; /* Address of Real*8 vector */ +int nbytes; /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp[8]; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp[7] = sbyte[0]; + temp[6] = sbyte[1]; + temp[5] = sbyte[2]; + temp[4] = sbyte[3]; + temp[3] = sbyte[4]; + temp[2] = sbyte[5]; + temp[1] = sbyte[6]; + temp[0] = sbyte[7]; + sbyte[0] = temp[0]; + sbyte[1] = temp[1]; + sbyte[2] = temp[2]; + sbyte[3] = temp[3]; + sbyte[4] = temp[4]; + sbyte[5] = temp[5]; + sbyte[6] = temp[6]; + sbyte[7] = temp[7]; + sbyte = sbyte + 8; + } + return; +} + + +/* Set flag if machine on which program is executing is not FITS byte order + * ( i.e., if it is an Alpha or PC instead of a Sun ) */ + +static int +machswap () + +{ + char *ctest; + int itest; + + itest = 1; + ctest = (char *)&itest; + if (*ctest) + return (1); + else + return (0); +} + + +/* ISIRAF -- return 1 if IRAF imh file, else 0 */ + +int +isiraf (filename) + +char *filename; /* Name of file for which to find size */ +{ + if (strchr (filename, '=')) + return (0); + else if (strsrch (filename, ".imh")) + return (1); + else + return (0); +} + + +/* IRAFSIZE -- return size of file in bytes */ + +static int +irafsize (diskfile) + +FILE *diskfile; /* Descriptor of file for which to find size */ +{ + long filesize; + long offset; + + offset = (long) 0; + + /* Move to end of the file */ + if (fseek (diskfile, offset, SEEK_END) == 0) { + + /* Position is the size of the file */ + filesize = ftell (diskfile); + + /* Move file pointer back tot he start of the file */ + fseek (diskfile, offset, SEEK_SET); + } + + else + filesize = -1; + + return (filesize); +} + +/* Feb 15 1996 New file + * Apr 10 1996 Add more documentation + * Apr 17 1996 Print error message on open failure + * Jun 5 1996 Add byte swapping (reversal); use streams + * Jun 10 1996 Make fixes after running lint + * Jun 12 1996 Use IMSWAP subroutines instead of local ones + * Jul 3 1996 Go back to using local IRAFSWAP subroutines + * Jul 3 1996 Write to pixel file from FITS header + * Jul 10 1996 Allocate all headers + * Aug 13 1996 Add unistd.h to include list + * Aug 26 1996 Allow 1-d images; fix comments; fix arguments after lint + * Aug 26 1996 Add IRAF header lingth argument to IRAFWIMAGE and IRAFWHEAD + * Aug 28 1996 Clean up code in IRAF2FITS + * Aug 30 1996 Use write instead of fwrite + * Sep 4 1996 Fix write mode bug + * Oct 15 1996 Drop unused variables + * Oct 17 1996 Minor fix after lint; cast arguments to STR2IRAF + * + * May 15 1997 Fix returned header length in IRAF2FITS + * Dec 19 1997 Add IRAF version 2 .imh files + * + * Jan 2 1998 Allow uneven length of user parameter lines in IRAF headers + * Jan 6 1998 Fix output of imh2 headers; allow newlines in imh1 headers + * Jan 14 1998 Handle byte reversing correctly + * Apr 17 1998 Add new IRAF data types unsigned char and unsigned short + * Apr 30 1998 Fix error return if illegal data type after Allan Brighton + * May 15 1998 Delete header keywords used for IRAF binary values + * May 15 1998 Fix bug so FITS OBJECT is put into IRAF title + * May 26 1998 Fix bug in fits2iraf keeping track of end of header + * May 27 1998 Include fitsio.h instead of fitshead.h + * Jun 4 1998 Write comments into header for converted IRAF binary values + * Jun 4 1998 Pad FITS strings to 8 character minimum + * Jul 24 1998 Write header file length to IRAF header file + * Jul 27 1998 Print error messages to stderr for all failed malloc's + * Jul 27 1998 Fix bug padding FITS header with spaces in iraf2fits + * Jul 27 1998 Write modification time to IRAF header file + * Aug 6 1998 Change fitsio.h to fitsfile.h; imhio.c to imhfile.c + * Oct 1 1998 Set irafswap flag only once per file + * Oct 5 1998 Add subroutines irafsize() and isiraf() + * Nov 16 1998 Fix byte-swap checking + * + * Jan 27 1999 Read and write all of 3D image if one dimension is =1 + * Jul 13 1999 Improve error messages; change irafsize() argument to fd + * Sep 22 1999 Don't copy OBJECT keyword from .imh file; use binary title + * Oct 14 1999 Set FITS header length + * Oct 20 1999 Allocate 5000 extra bytes for IRAF header + * Nov 2 1999 Fix getclocktime() to use only time.h subroutines + * Nov 2 1999 Add modification date and time to FITS header in iraf2fits() + * Nov 24 1999 Delete HEADSWAP, IMHVER, DATE-MOD from header before writing + * Nov 29 1999 Delete PIXSWAP, IRAF-MIN, IRAF-MAX from header before writing + * + * Jan 13 2000 Fix bug which dropped characters in iraf2fits() + * Feb 3 2000 Declare timezone long, not time_t; drop unused variable + * Mar 7 2000 Add more code to keep pixel file path short + * Mar 10 2000 Fix bugs when writing .imh file headers + * Mar 21 2000 Change computation of IRAF time tags to use only data structure + * Mar 22 2000 Move IRAF time tag computation to lt2tsi() in dateutil.c + * Mar 24 2000 Use Unix file update time if none in header + * Mar 27 2000 Use hputm() to save file paths up to 256 characters + * Mar 27 2000 Write filename comments after 1st keyword with short value + * Mar 27 2000 Allocate pixel file name in same_path to imh2 length + * Mar 29 2000 Add space after last linefeed of header in fits2iraf() + * Apr 28 2000 Dimension pixname in irafwimage() + * May 1 2000 Fix code for updating pixel file name with HDR$ in fits2iraf() + * Jun 2 2000 Drop unused variables in fits2iraf() after lint + * Jun 12 2000 If pixel filename has no / or $, use same path as header file + * Sep 6 2000 Use header directory if pixel file not found at its pathname + * + * Jan 11 2001 Print all messages to stderr + * Aug 24 2001 In isiraf(), return 0 if argument contains an equal sign + * + * Apr 8 2002 Fix bug in error message for unidentified nbits in fits2iraf() + * + * Feb 4 2003 Open catalog file rb instead of r (Martin Ploner, Bern) + * Oct 31 2003 Read image only in irafrimage() if physical dimension > image dim. + * Nov 3 2003 Set NAXISi to image, not physical dimensions in iraf2fits() + * + * Jun 13 2005 Drop trailing spaces on pixel file name + * + * Jun 20 2006 Initialize uninitialized variables + * + * Jan 4 2007 Change hputr4() calls to send pointer to value + * Jan 8 2007 Drop unused variable nbx in irafrimage() + * Jan 8 2007 Align header and image buffers properly by 4 and by BITPIX + * + * May 20 2011 Free newpixname, not pixname in irafwimage() + * + * Mar 27 2012 Fix pixname's appending to newpixname to avoid overflow + */ diff --git a/tksao/wcssubs/imio.c b/tksao/wcssubs/imio.c new file mode 100644 index 0000000..3243283 --- /dev/null +++ b/tksao/wcssubs/imio.c @@ -0,0 +1,1544 @@ +/*** File wcslib/imio.c + *** October 30, 2012 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2012 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: imio.c (image pixel manipulation) + * Purpose: Read and write pixels from arbitrary data type 2D arrays + * Subroutine: getpix (image, bitpix, w, h, bz, bs, x, y) + * Read pixel from 2D image of any numeric type (0,0 lower left) + * Subroutine: getpix1 (image, bitpix, w, h, bz, bs, x, y) + * Read pixel from 2D image of any numeric type (1,1 lower left) + * Subroutine: putpix (image, bitpix, w, h, bz, bs, x, y, dpix) + * Write pixel into 2D image of any numeric type (0,0 lower left) + * Subroutine: putpix1 (image, bitpix, w, h, bz, bs, x, y, dpix) + * Write pixel into 2D image of any numeric type (1,1 lower left) + * Subroutine: addpix (image, bitpix, w, h, bz, bs, x, y, dpix) + * Copy pixel into 2D image of any numeric type (0,0 lower left) + * Subroutine: addpix1 (image, bitpix, w, h, bz, bs, x, y, dpix) + * Add pixel into 2D image of any numeric type (1,1 lower left) + * Subroutine: maxvec (image, bitpix, bz, bs, pix1, npix) + * Get maximum of vector from 2D image of any numeric type + * Subroutine: minvec (image, bitpix, bz, bs, pix1, npix) + * Get minimum of vector from 2D image of any numeric type + * Subroutine: getvec (image, bitpix, bz, bs, pix1, npix, dvec) + * Get vector from 2D image of any numeric type + * Subroutine: putvec (image, bitpix, bz, bs, pix1, npix, dvec) + * Copy pixel vector into a vector of any numeric type + * Subroutine: addvec (image, bitpix, bz, bs, pix1, npix, dpix) + * Add constant to pixel values in a vector + * Subroutine: multvec (image, bitpix, bz, bs, pix1, npix, dpix) + * Multiply pixel values in a vector by a constant + * Subroutine: fillvec (image, bitpix, bz, bs, pix1, npix, dpix) + * Copy pixel value in a vector of any numeric type + * Subroutine: fillvec1 (image, bitpix, bz, bs, pix1, npix, dpix) + * Copy pixel value int a vector of any numeric type + * Subroutine: movepix (image1, bitpix, w1, x1, y1, image2, w2, x2, y2) + * Copy pixel from one image location to another + * Subroutine: imswap (bitpix,string,nbytes) + * Swap bytes in string in place, with FITS bits/pixel code + * Subroutine: imswap2 (string,nbytes) + * Swap bytes in string in place + * Subroutine imswap4 (string,nbytes) + * Reverse bytes of Integer*4 or Real*4 vector in place + * Subroutine imswap8 (string,nbytes) + * Reverse bytes of Real*8 vector in place + * Subroutine imswapped () + * Return 1 if PC/DEC byte order, else 0 + */ + +#include <stdlib.h> +#include <stdio.h> +#include "fitsfile.h" + +static int scale = 1; /* If 0, skip scaling step */ +void +setscale (scale0) +int scale0; +{scale = scale0; return;} + +/* GETPIX1 -- Get pixel from 2D FITS image of any numeric type */ + +double +getpix1 (image, bitpix, w, h, bzero, bscale, x, y) + +char *image; /* Image array as 1-D vector */ +int bitpix; /* FITS bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; /* One-based horizontal pixel number */ +int y; /* One-based vertical pixel number */ + +{ + return (getpix (image, bitpix, w, h, bzero, bscale, x-1, y-1)); +} + + +/* GETPIX -- Get pixel from 2D image of any numeric type */ + +double +getpix (image, bitpix, w, h, bzero, bscale, x, y) + +char *image; /* Image array as 1-D vector */ +int bitpix; /* FITS bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; /* Zero-based horizontal pixel number */ +int y; /* Zero-based vertical pixel number */ + +{ + short *im2; + int *im4; + unsigned char *im1; + unsigned short *imu; + float *imr; + double *imd; + double dpix; + +/* Return 0 if coordinates are not inside image */ + if (x < 0 || x >= w) + return (0.0); + if (y < 0 || y >= h) + return (0.0); + +/* Extract pixel from appropriate type of array */ + switch (bitpix) { + + case 8: + im1 = (unsigned char *)image; + dpix = (double) im1[(y*w) + x]; + break; + + case 16: + im2 = (short *)image; + dpix = (double) im2[(y*w) + x]; + break; + + case 32: + im4 = (int *)image; + dpix = (double) im4[(y*w) + x]; + break; + + case -16: + imu = (unsigned short *)image; + dpix = (double) imu[(y*w) + x]; + break; + + case -32: + imr = (float *)image; + dpix = (double) imr[(y*w) + x]; + break; + + case -64: + imd = (double *)image; + dpix = imd[(y*w) + x]; + break; + + default: + dpix = 0.0; + } + if (scale) + return (bzero + (bscale * dpix)); + else + return (dpix); +} + + +/* PUTPIX1 -- Copy pixel into 2D FITS image of any numeric type */ + +void +putpix1 (image, bitpix, w, h, bzero, bscale, x, y, dpix) + +char *image; +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; /* One-based horizontal pixel number */ +int y; /* One-based vertical pixel number */ +double dpix; + +{ + putpix (image, bitpix, w, h, bzero, bscale, x-1, y-1, dpix); + return; +} + + +/* PUTPIX -- Copy pixel into 2D image of any numeric type */ + +void +putpix (image, bitpix, w, h, bzero, bscale, x, y, dpix) + +char *image; +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; +int y; +double dpix; + +{ + double *imd; + float *imr; + int *im4; + short *im2; + unsigned short *imu; + unsigned char *im1; + +/* Return if coordinates are not inside image */ + if (x < 0 || x >= w) + return; + if (y < 0 || y >= h) + return; + + if (scale) + dpix = (dpix - bzero) / bscale; + + switch (bitpix) { + + case 8: + im1 = (unsigned char *)image; + if (dpix < 0) + im1[(y*w) + x] = (unsigned char) (dpix - 0.5); + else + im1[(y*w) + x] = (unsigned char) (dpix + 0.5); + break; + + case 16: + im2 = (short *)image; + if (dpix < 0) + im2[(y*w) + x] = (short) (dpix - 0.5); + else + im2[(y*w) + x] = (short) (dpix + 0.5); + break; + + case 32: + im4 = (int *)image; + if (dpix < 0) + im4[(y*w) + x] = (int) (dpix - 0.5); + else + im4[(y*w) + x] = (int) (dpix + 0.5); + break; + + case -16: + imu = (unsigned short *)image; + if (dpix < 0) + imu[(y*w) + x] = (unsigned short) 0; + else + imu[(y*w) + x] = (unsigned short) (dpix + 0.5); + break; + + case -32: + imr = (float *)image; + imr[(y*w) + x] = (float) dpix; + break; + + case -64: + imd = (double *)image; + imd[(y*w) + x] = dpix; + break; + + } + return; +} + + +/* ADDPIX1 -- Add pixel value into 2D FITS image of any numeric type */ + +void +addpix1 (image, bitpix, w, h, bzero, bscale, x, y, dpix) + +char *image; +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; /* One-based horizontal pixel number */ +int y; /* One-based vertical pixel number */ +double dpix; /* Value to add to pixel */ + +{ + addpix (image, bitpix, w, h, bzero, bscale, x-1, y-1, dpix); + return; +} + + +/* ADDPIX -- Add constant to pixel values in 2D image of any numeric type */ + +void +addpix (image, bitpix, w, h, bzero, bscale, x, y, dpix) + +char *image; +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w; /* Image width in pixels */ +int h; /* Image height in pixels */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int x; /* Zero-based horizontal pixel number */ +int y; /* Zero-based vertical pixel number */ +double dpix; /* Value to add to pixel */ + +{ + double *imd; + float *imr; + int *im4; + short *im2; + unsigned short *imu; + unsigned char *im1; + int ipix; + +/* Return if coordinates are not inside image */ + if (x < 0 || x >= w) + return; + if (y < 0 || y >= h) + return; + + if (scale) + dpix = (dpix - bzero) / bscale; + ipix = (y * w) + x; + + switch (bitpix) { + + case 8: + im1 = (unsigned char *)image; + if (dpix < 0) + image[ipix] = im1[ipix] + (unsigned char) (dpix - 0.5); + else + image[ipix] = im1[ipix] + (unsigned char) (dpix + 0.5); + break; + + case 16: + im2 = (short *)image; + if (dpix < 0) + im2[ipix] = im2[ipix] + (short) (dpix - 0.5); + else + im2[ipix] = im2[ipix] + (short) (dpix + 0.5); + break; + + case 32: + im4 = (int *)image; + if (dpix < 0) + im4[ipix] = im4[ipix] + (int) (dpix - 0.5); + else + im4[ipix] = im4[ipix] + (int) (dpix + 0.5); + break; + + case -16: + imu = (unsigned short *)image; + if (dpix > 0) + imu[ipix] = imu[ipix] + (unsigned short) (dpix + 0.5); + break; + + case -32: + imr = (float *)image; + imr[ipix] = imr[ipix] + (float) dpix; + break; + + case -64: + imd = (double *)image; + imd[ipix] = imd[ipix] + dpix; + break; + + } + return; +} + + +/* MOVEPIX -- Copy pixel between images */ + +void +movepix (image1, bitpix1, w1, x1, y1, image2, bitpix2, w2, x2, y2) + +char *image1; /* Pointer to first pixel in input image */ +int bitpix1; /* Bits per input pixel (FITS codes) */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w1; /* Number of horizontal pixels in input image */ +int x1, y1; /* Row and column for input pixel */ + +char *image2; /* Pointer to first pixel in output image */ +int bitpix2; /* Bits per output pixel (FITS codes) */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +int w2; /* Number of horizontal pixels in output image */ +int x2, y2; /* Row and column for output pixel */ + +{ + double dpix, *imd1, *imd2; + float rpix, *imr1, *imr2; + int *imi1, *imi2; + short *ims1, *ims2; + unsigned short *imu1, *imu2; + unsigned char *imc1, *imc2; + + if (x1 < 0 || x2 < 0 || x1 >= w1 || x2 >= w2) + return; + if (y1 < 0 || y2 < 0) + return; + + switch (bitpix1) { + + case 8: + imc1 = (unsigned char *)image1; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image2; + imc2[(y2*w2) + x2] = imc1[(y1*w1) + x1]; + break; + case 16: + ims2 = (short *)image2; + ims2[(y2*w2) + x2] = (short) imc1[(y1*w1) + x1]; + break; + case 32: + imi2 = (int *)image2; + imi2[(y2*w2) + x2] = (int) imc1[(y1*w1) + x1]; + break; + case -16: + imu2 = (unsigned short *)image2; + imu2[(y2*w2) + x2] = (unsigned short) imc1[(y1*w1) + x1]; + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = (float) imc1[(y1*w1) + x1]; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = (double) imc1[(y1*w1) + x1]; + break; + } + break; + + case 16: + ims1 = (short *)image1; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image1; + imc2[(y2*w2) + x2] = (unsigned char) ims1[(y1*w1) + x1]; + break; + case 16: + ims2 = (short *)image2; + ims2[(y2*w2) + x2] = ims1[(y1*w1) + x1]; + break; + case 32: + imi2 = (int *)image2; + imi2[(y2*w2) + x2] = (int) ims1[(y1*w1) + x1]; + break; + case -16: + imu2 = (unsigned short *)image2; + imu2[(y2*w2) + x2] = (unsigned short) ims1[(y1*w1) + x1]; + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = (float) ims1[(y1*w1) + x1]; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = (double) ims1[(y1*w1) + x1]; + break; + } + break; + + case 32: + imi1 = (int *)image1; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image2; + imc2[(y2*w2) + x2] = (unsigned char) imi1[(y1*w1) + x1]; + break; + case 16: + ims2 = (short *)image2; + ims2[(y2*w2) + x2] = (short) imi1[(y1*w1) + x1]; + break; + case 32: + imi2 = (int *)image2; + imi2[(y2*w2) + x2] = imi1[(y1*w1) + x1]; + break; + case -16: + imu2 = (unsigned short *)image2; + imu2[(y2*w2) + x2] = (unsigned short) imi1[(y1*w1) + x1]; + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = (float) imi1[(y1*w1) + x1]; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = (double) imi1[(y1*w1) + x1]; + break; + } + break; + + case -16: + imu1 = (unsigned short *)image1; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image2; + imc2[(y2*w2) + x2] = (unsigned char) imu1[(y1*w1) + x1]; + break; + case 16: + ims2 = (short *)image2; + ims2[(y2*w2) + x2] = (short) imu1[(y1*w1) + x1]; + break; + case 32: + imi2 = (int *)image2; + imi2[(y2*w2) + x2] = (int) imu1[(y1*w1) + x1]; + break; + case -16: + imu2 = (unsigned short *)image2; + imu2[(y2*w2) + x2] = imu1[(y1*w1) + x1]; + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = (float) imu1[(y1*w1) + x1]; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = (double) imu1[(y1*w1) + x1]; + break; + } + break; + + case -32: + imr1 = (float *)image1; + rpix = imr1[(y1*w1) + x1]; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image2; + if (rpix < 0.0) + imc2[(y2*w2) + x2] = (unsigned char) 0; + else + imc2[(y2*w2) + x2] = (unsigned char) (rpix + 0.5); + break; + case 16: + ims2 = (short *)image2; + if (rpix < 0.0) + ims2[(y2*w2) + x2] = (short) (rpix - 0.5); + else + ims2[(y2*w2) + x2] = (short) (rpix + 0.5); + break; + case 32: + imi2 = (int *)image2; + if (rpix < 0.0) + imi2[(y2*w2) + x2] = (int) (rpix - 0.5); + else + imi2[(y2*w2) + x2] = (int) (rpix + 0.5); + break; + case -16: + imu2 = (unsigned short *)image2; + if (rpix < 0.0) + imu2[(y2*w2) + x2] = (unsigned short) 0; + else + imu2[(y2*w2) + x2] = (unsigned short) (rpix + 0.5); + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = rpix; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = (double) rpix; + break; + } + break; + + case -64: + imd1 = (double *)image1; + dpix = imd1[(y1*w1) + x1]; + switch (bitpix2) { + case 8: + imc2 = (unsigned char *)image2; + if (dpix < 0.0) + imc2[(y2*w2) + x2] = (unsigned char) 0; + else + imc2[(y2*w2) + x2] = (unsigned char) (dpix + 0.5); + break; + case 16: + ims2 = (short *)image2; + if (dpix < 0.0) + ims2[(y2*w2) + x2] = (short) (dpix - 0.5); + else + ims2[(y2*w2) + x2] = (short) (dpix + 0.5); + break; + case 32: + imi2 = (int *)image2; + if (dpix < 0.0) + imi2[(y2*w2) + x2] = (int) (dpix - 0.5); + else + imi2[(y2*w2) + x2] = (int) (dpix + 0.5); + break; + case -16: + imu2 = (unsigned short *)image2; + if (dpix < 0.0) + imu2[(y2*w2) + x2] = (unsigned short) 0; + else + imu2[(y2*w2) + x2] = (unsigned short) (dpix + 0.5); + break; + case -32: + imr2 = (float *)image2; + imr2[(y2*w2) + x2] = (float) dpix; + break; + case -64: + imd2 = (double *)image2; + imd2[(y2*w2) + x2] = dpix; + break; + } + break; + } + return; +} + + +/* MAXVEC -- Get maximum value in vector from 2D image of any numeric type */ + +double +maxvec (image, bitpix, bzero, bscale, pix1, npix) + +char *image; /* Image array from which to read vector */ +int bitpix; /* Number of bits per pixel in image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel to check */ +int npix; /* Number of pixels to check */ + +{ + short *im2, imax2, ip2; + int *im4, imax4, ip4; + unsigned short *imu, imaxu, ipu; + float *imr, imaxr, ipr; + double *imd; + double dmax = 0.0; + double ipd; + int ipix, pix2; + unsigned char *imc, imaxc, ipc; + + pix2 = pix1 + npix; + + switch (bitpix) { + + case 8: + imc = (unsigned char *)(image); + imaxc = *(imc + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipc = *(imc + ipix); + if (ipc > imaxc) + imaxc = ipc; + } + dmax = (double) imaxc; + break; + + case 16: + im2 = (short *)image; + imax2 = *(im2 + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ip2 = *(im2 + ipix); + if (ip2 > imax2) + imax2 = ip2; + } + dmax = (double) imax2; + break; + + case 32: + im4 = (int *)image; + imax4 = *(im4 + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ip4 = *(im4 + ipix); + if (ip4 > imax4) + imax4 = ip4; + } + dmax = (double) imax4; + break; + + case -16: + imu = (unsigned short *)image; + imaxu = *(imu + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipu = *(imu + ipix); + if (ipu > imaxu) + imaxu = ipu; + } + dmax = (double) imaxu; + break; + + case -32: + imr = (float *)image; + imaxr = *(imr + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipr = *(imr + ipix); + if (ipr > imaxr) + imax2 = ipr; + } + dmax = (double) imaxr; + break; + + case -64: + imd = (double *)image; + dmax = *(imd + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipd = *(imd + ipix); + if (ipd > dmax) + dmax = ipd; + } + break; + + } + + /* Scale data if either BZERO or BSCALE keyword has been set */ + if (scale && (bzero != 0.0 || bscale != 1.0)) + dmax = (dmax * bscale) + bzero; + + return (dmax); +} + + +/* MINVEC -- Get minimum value in vector from 2D image of any numeric type */ + +double +minvec (image, bitpix, bzero, bscale, pix1, npix) + +char *image; /* Image array from which to read vector */ +int bitpix; /* Number of bits per pixel in image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel to check */ +int npix; /* Number of pixels to check */ + +{ + short *im2, imin2, ip2; + int *im4, imin4, ip4; + unsigned short *imu, iminu, ipu; + float *imr, iminr, ipr; + double *imd, ipd; + double dmin = 0.0; + int ipix, pix2; + unsigned char *imc, cmin, cp; + + pix2 = pix1 + npix; + + switch (bitpix) { + + case 8: + imc = (unsigned char *)image; + cmin = *(imc + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + cp = *(imc + ipix); + if (cp < cmin) + cmin = cp; + } + dmin = (double) cmin; + break; + + case 16: + im2 = (short *)image + pix1; + imin2 = *im2; + for (ipix = pix1; ipix < pix2; ipix++) { + ip2 = *(im2 + ipix); + if (ip2 < imin2) + imin2 = ip2; + } + dmin = (double) imin2; + break; + + case 32: + im4 = (int *)image; + imin4 = *(im4 + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ip4 = *(im4 + ipix); + if (ip4 < imin4) + imin4 = ip4; + } + dmin = (double) imin4; + break; + + case -16: + imu = (unsigned short *)image; + iminu = *(imu + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipu = *(imu + ipix); + if (ipu < iminu) + iminu = ipu; + } + dmin = (double) iminu; + break; + + case -32: + imr = (float *)image; + iminr = *(imr + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipr = *(imr + ipix); + if (ipr < iminr) + iminr = ipr; + } + dmin = (double) iminr; + break; + + case -64: + imd = (double *)image; + dmin = *(imd + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + ipd = *(imd + ipix); + if (ipd < dmin) + dmin = ipd; + } + break; + + } + + /* Scale data if either BZERO or BSCALE keyword has been set */ + if (scale && (bzero != 0.0 || bscale != 1.0)) + dmin = (dmin * bscale) + bzero; + + return (dmin); +} + + +/* ADDVEC -- Add constant to pixel values in 2D image of any numeric type */ + +void +addvec (image, bitpix, bzero, bscale, pix1, npix, dpix) + +char *image; /* Image array from which to extract vector */ +int bitpix; /* Number of bits per pixel in image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel to extract */ +int npix; /* Number of pixels to extract */ +double dpix; /* Value to add to pixels */ + +{ + unsigned char *imc, ccon; + short *im2, jcon; + int *im4, icon; + unsigned short *imu, ucon; + float *imr, rcon; + double *imd; + int ipix, pix2; + + pix2 = pix1 + npix; + + if (scale) + dpix = (dpix - bzero) / bscale; + + switch (bitpix) { + + case 8: + imc = (unsigned char *) (image + pix1); + if (dpix < 0) + ccon = (unsigned char) (dpix - 0.5); + else + ccon = (unsigned char) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *imc++ += ccon; + break; + + case 16: + im2 = (short *) (image + pix1); + if (dpix < 0) + jcon = (short) (dpix - 0.5); + else + jcon = (short) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *im2++ += jcon; + break; + + case 32: + im4 = (int *) (image + pix1); + if (dpix < 0) + icon = (int) (dpix - 0.5); + else + icon = (int) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *im4++ += icon; + break; + + case -16: + imu = (unsigned short *) (image + pix1); + if (dpix > 0) { + ucon = (unsigned short) (dpix + 0.5); + imu = (unsigned short *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imu++ += ucon; + } + else { + icon = (int) (dpix - 0.5); + imu = (unsigned short *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) { + unsigned short tmp = (icon + (int) *imu); + *imu++ += tmp; + } + } + break; + + case -32: + rcon = (float) dpix; + imr = (float *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imr++ += rcon; + break; + + case -64: + imd = (double *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imd++ += dpix; + break; + } + return; +} + + +/* MULTVEC -- Multiply pixel values in place in 2D image of any numeric type */ + +void +multvec (image, bitpix, bzero, bscale, pix1, npix, dpix) + +char *image; /* Image array from which to extract vector */ +int bitpix; /* Number of bits per pixel in image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel to extract */ +int npix; /* Number of pixels to extract */ +double dpix; /* Value by which to multiply pixels */ + +{ + char *imc, ccon; + short *im2, jcon; + int *im4, icon, isint; + unsigned short *imu, ucon; + float *imr, rcon; + double *imd, dcon, dval; + int ipix, pix2; + + pix2 = pix1 + npix; + + if (scale) + dpix = (dpix - bzero) / bscale; + ipix = (int) dpix; + dcon = (double) ipix; + if (dcon == dpix) + isint = 1; + else + isint = 0; + + switch (bitpix) { + + case 8: + imc = image + pix1; + if (isint) { + if (dpix < 0) + ccon = (char) (dpix - 0.5); + else + ccon = (char) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *imc++ *= ccon; + } + else { + for (ipix = pix1; ipix < pix2; ipix++) { + dval = ((double) *imc) * dpix; + if (dval < 256.0) + *imc++ = (char) dval; + else + *imc++ = (char) 255; + } + } + break; + + case 16: + im2 = (short *) (image + pix1); + if (isint) { + im2 = (short *)image; + if (dpix < 0) + jcon = (short) (dpix - 0.5); + else + jcon = (short) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *im2++ *= jcon; + } + else { + for (ipix = pix1; ipix < pix2; ipix++) { + dval = ((double) *im2) * dpix; + if (dval < 32768.0) + *im2++ = (short) dval; + else + *im2++ = (short) 32767; + } + } + break; + + case 32: + im4 = (int *) (image + pix1); + if (isint) { + if (dpix < 0) + icon = (int) (dpix - 0.5); + else + icon = (int) (dpix + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + *im4++ *= icon; + } + else { + for (ipix = pix1; ipix < pix2; ipix++) { + dval = ((double) *im4) * dpix; + if (dval < 32768.0) + *im4++ = (int) dval; + else + *im4++ = (int) 32767; + } + } + break; + + case -16: + imu = (unsigned short *) (image + pix1); + if (dpix > 0) { + ucon = (unsigned short) (dpix + 0.5); + imu = (unsigned short *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imu++ *= ucon; + } + break; + + case -32: + rcon = (float) dpix; + imr = (float *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imr++ *= rcon; + break; + + case -64: + imd = (double *) (image + pix1); + for (ipix = pix1; ipix < pix2; ipix++) + *imd++ *= dpix; + break; + + } + return; +} + + +/* GETVEC -- Get vector from 2D image of any numeric type */ + +void +getvec (image, bitpix, bzero, bscale, pix1, npix, dvec0) + +char *image; /* Image array from which to extract vector */ +int bitpix; /* Number of bits per pixel in image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel to extract */ +int npix; /* Number of pixels to extract */ +double *dvec0; /* Vector of pixels (returned) */ + +{ + short *im2; + int *im4; + unsigned short *imu; + float *imr; + double *imd; + double *dvec; + int ipix, pix2; + + pix2 = pix1 + npix; + dvec = dvec0; + + switch (bitpix) { + + case 8: + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(image + ipix); + break; + + case 16: + im2 = (short *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(im2 + ipix); + break; + + case 32: + im4 = (int *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(im4 + ipix); + break; + + case -16: + imu = (unsigned short *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(imu + ipix); + break; + + case -32: + imr = (float *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(imr + ipix); + break; + + case -64: + imd = (double *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *dvec++ = (double) *(imd + ipix); + break; + + } + + /* Scale data if either BZERO or BSCALE keyword has been set */ + if (scale && (bzero != 0.0 || bscale != 1.0)) { + dvec = dvec0; + for (ipix = pix1; ipix < pix2; ipix++) { + *dvec = (*dvec * bscale) + bzero; + dvec++; + } + } + + return; +} + + +/* PUTVEC -- Copy pixel vector into 2D image of any numeric type */ + +void +putvec (image, bitpix, bzero, bscale, pix1, npix, dvec) + +char *image; /* Image into which to copy vector */ +int bitpix; /* Number of bits per pixel im image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* Offset of first pixel of vector in image */ +int npix; /* Number of pixels to copy */ +double *dvec; /* Vector of pixels to copy */ + +{ + short *im2; + int *im4; + unsigned short *imu; + float *imr; + double *imd; + int ipix, pix2; + double *dp = dvec; + + pix2 = pix1 + npix; + + /* Scale data if either BZERO or BSCALE keyword has been set */ + if (scale && (bzero != 0.0 || bscale != 1.0)) { + for (ipix = pix1; ipix < pix2; ipix++) { + *dp = (*dp - bzero) / bscale; + dp++; + } + dp = dvec; + } + + switch (bitpix) { + + case 8: + for (ipix = pix1; ipix < pix2; ipix++) + *(image+ipix) = (char) *dp++; + break; + + case 16: + im2 = (short *)image; + for (ipix = pix1; ipix < pix2; ipix++) { + if (*dp < 0.0) + *(im2+ipix) = (short) (*dp++ - 0.5); + else + *(im2+ipix) = (short) (*dp++ + 0.5); + } + break; + + case 32: + im4 = (int *)image; + for (ipix = pix1; ipix < pix2; ipix++) { + if (*dp < 0.0) + *(im4+ipix) = (int) (*dp++ - 0.5); + else + *(im4+ipix) = (int) (*dp++ + 0.5); + } + break; + + case -16: + imu = (unsigned short *)image; + for (ipix = pix1; ipix < pix2; ipix++) { + if (*dp < 0.0) + *(imu+ipix) = (unsigned short) 0; + else + *(imu+ipix) = (unsigned short) (*dp++ + 0.5); + } + break; + + case -32: + imr = (float *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *(imr+ipix) = (float) *dp++; + break; + + case -64: + imd = (double *)image; + for (ipix = pix1; ipix < pix2; ipix++) + *(imd+ipix) = (double) *dp++; + break; + } + return; +} + + +/* FILLVEC1 -- Copy single value into a vector of any numeric type */ + +void +fillvec1 (image, bitpix, bzero, bscale, pix1, npix, dpix) + +char *image; /* Vector to fill */ +int bitpix; /* Number of bits per pixel im image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* First pixel to fill */ +int npix; /* Number of pixels to fill */ +double dpix; /* Value with which to fill pixels */ +{ + fillvec (image, bitpix, bzero, bscale, pix1-1, npix, dpix); + return; +} + + +/* FILLVEC -- Copy single value into a vector of any numeric type */ + +void +fillvec (image, bitpix, bzero, bscale, pix1, npix, dpix) + +char *image; /* Vector to fill */ +int bitpix; /* Number of bits per pixel im image */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +double bzero; /* Zero point for pixel scaling */ +double bscale; /* Scale factor for pixel scaling */ +int pix1; /* First pixel to fill */ +int npix; /* Number of pixels to fill */ +double dpix; /* Value with which to fill pixels */ +{ + char ipc; + short *im2, ip2; + int *im4, ip4; + unsigned short *imu, ipu; + float *imr, ipr; + double *imd; + int ipix, pix2; + double dp; + + pix2 = pix1 + npix; + + /* Scale data if either BZERO or BSCALE keyword has been set */ + dp = dpix; + if (scale && (bzero != 0.0 || bscale != 1.0)) + dp = (dp - bzero) / bscale; + + switch (bitpix) { + + case 8: + if (dp < 0.0) + ipc = (char) (dp - 0.5); + else + ipc = (char) (dp + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + image[ipix] = ipc; + break; + + case 16: + im2 = (short *)image; + if (dp < 0.0) + ip2 = (short) (dp - 0.5); + else + ip2 = (short) (dp + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + im2[ipix] = ip2; + break; + + case 32: + im4 = (int *)image; + if (dp < 0.0) + ip4 = (int) (dp - 0.5); + else + ip4 = (int) (dp + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + im4[ipix] = ip4; + break; + + case -16: + imu = (unsigned short *)image; + if (dp < 0.0) + ipu = (unsigned short) (dp - 0.5); + else + ipu = (unsigned short) (dp + 0.5); + for (ipix = pix1; ipix < pix2; ipix++) + imu[ipix] = ipu; + break; + + case -32: + imr = (float *)image; + ipr = (float) dp; + for (ipix = pix1; ipix < pix2; ipix++) + imr[ipix] = ipr; + break; + + case -64: + imd = (double *)image; + for (ipix = pix1; ipix < pix2; ipix++) + imd[ipix] = dp; + break; + } + return; +} + + +/* IMSWAP -- Reverse bytes of any type of vector in place */ + +void +imswap (bitpix, string, nbytes) + +int bitpix; /* Number of bits per pixel */ + /* 16 = short, -16 = unsigned short, 32 = int */ + /* -32 = float, -64 = double */ +char *string; /* Address of starting point of bytes to swap */ +int nbytes; /* Number of bytes to swap */ + +{ + switch (bitpix) { + + case 8: + break; + + case 16: + if (nbytes < 2) return; + imswap2 (string,nbytes); + break; + + case 32: + if (nbytes < 4) return; + imswap4 (string,nbytes); + break; + + case -16: + if (nbytes < 2) return; + imswap2 (string,nbytes); + break; + + case -32: + if (nbytes < 4) return; + imswap4 (string,nbytes); + break; + + case -64: + if (nbytes < 8) return; + imswap8 (string,nbytes); + break; + + } + return; +} + + +/* IMSWAP2 -- Swap bytes in string in place */ + +void +imswap2 (string,nbytes) + + +char *string; /* Address of starting point of bytes to swap */ +int nbytes; /* Number of bytes to swap */ + +{ + char *sbyte, temp, *slast; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp = sbyte[0]; + sbyte[0] = sbyte[1]; + sbyte[1] = temp; + sbyte= sbyte + 2; + } + return; +} + + +/* IMSWAP4 -- Reverse bytes of Integer*4 or Real*4 vector in place */ + +void +imswap4 (string,nbytes) + +char *string; /* Address of Integer*4 or Real*4 vector */ +int nbytes; /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp0, temp1, temp2, temp3; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp3 = sbyte[0]; + temp2 = sbyte[1]; + temp1 = sbyte[2]; + temp0 = sbyte[3]; + sbyte[0] = temp0; + sbyte[1] = temp1; + sbyte[2] = temp2; + sbyte[3] = temp3; + sbyte = sbyte + 4; + } + + return; +} + + +/* IMSWAP8 -- Reverse bytes of Real*8 vector in place */ + +void +imswap8 (string,nbytes) + +char *string; /* Address of Real*8 vector */ +int nbytes; /* Number of bytes to reverse */ + +{ + char *sbyte, *slast; + char temp[8]; + + slast = string + nbytes; + sbyte = string; + while (sbyte < slast) { + temp[7] = sbyte[0]; + temp[6] = sbyte[1]; + temp[5] = sbyte[2]; + temp[4] = sbyte[3]; + temp[3] = sbyte[4]; + temp[2] = sbyte[5]; + temp[1] = sbyte[6]; + temp[0] = sbyte[7]; + sbyte[0] = temp[0]; + sbyte[1] = temp[1]; + sbyte[2] = temp[2]; + sbyte[3] = temp[3]; + sbyte[4] = temp[4]; + sbyte[5] = temp[5]; + sbyte[6] = temp[6]; + sbyte[7] = temp[7]; + sbyte = sbyte + 8; + } + return; +} + +/* IMSWAPPED -- Returns 0 if big-endian (Sun,Mac), + 1 if little-endian(PC,Alpha) */ + +int +imswapped () + +{ + char *ctest; + int itest; + + itest = 1; + ctest = (char *)&itest; + if (*ctest) + return (1); + else + return (0); +} + +/* Apr 17 1996 New file + * May 22 1996 Add H so that PUTPIX and GETPIX can check coordinates + * Jun 11 1996 Simplify NEWIMAGE subroutine + * Jun 12 1996 Add byte-swapping subroutines + * + * Jul 24 1997 Add 8-bit option to subroutines + * + * May 27 1998 Include imio.h instead of fitshead.h + * Jun 17 1998 Fix bug, changing all unsigned int's to unsigned short's + * + * Apr 29 1999 Add scaling to getpix, putpix, getvec, and putvec + * Apr 29 1999 Fix bug in getvec in dealing with 1-byte data + * Sep 14 1999 Change dp incrementing so it works on Alpha compiler + * Sep 27 1999 Add interface for 1-based (FITS) image access + * Sep 27 1999 Add addpix() and addpix1() + * Dec 14 1999 In putpix(), addpix(), putvec(), round when output is integer + * + * Sep 20 2000 In getvec(), scale only if necessary + * + * Nov 27 2001 In movepix(), add char to char move + * + * Jan 23 2002 Add global scale switch to turn off scaling + * Jun 4 2002 In getvec() and putvec(), change dpix to dvec + * Jun 4 2002 Add addvec() to add to a vector + * Jul 19 2002 Fix getvec() bug rescaling scaled numbers + * + * May 20 2003 Declare scale0 in setscale() + * + * Jan 28 2004 Add image limit check to movepix() + * Feb 27 2004 Add fillvec() and fillvec1() to set vector to a constant + * + * Jun 27 2005 Fix major bug in fillvec(); pass value dpix in fillvec1(), too + * Aug 18 2005 Add maxvec(), addvec(), and multvec() + * + * Mar 1 2006 Fix bug of occasional double application of bscale in getvec() + * Apr 3 2006 Fix bad cast in unisigned int section of addvec() + * May 3 2006 Code fixes in addpix and multpix suggested by Robert Lupton + * Jun 8 2006 Drop erroneous second im2 assignment without offset in addvec() + * Jun 20 2006 Fix typos masquerading as unitialized variables + * + * Jan 8 2007 Include fitsfile.h instead of imio.h + * Jun 11 2007 Add minvec() and speed up maxvec() + * + * Apr 12 2012 Fix 8-bit variables to be unsigned char + * Oct 19 2012 Fix errors with character images in minvec() and maxvec() + * Oct 31 2012 Fix errors with short images in minvec() and maxvec() + * Oct 31 2012 Drop unused variable il2 from minvec() + */ diff --git a/tksao/wcssubs/imio.h b/tksao/wcssubs/imio.h new file mode 100644 index 0000000..a12d8e8 --- /dev/null +++ b/tksao/wcssubs/imio.h @@ -0,0 +1,64 @@ +/*** imio.h memory access subroutines + *** September 27, 1999 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1996-2002 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +#ifndef imio_h_ +#define imio_h_ + +/* Image pixel access subroutines in imio.c */ +extern double getpix(); /* Read one pixel from any data type 2-D array (0,0)*/ +extern double getpix1(); /* Read one pixel from any data type 2-D array (1,1)*/ +extern void putpix(); /* Write one pixel to any data type 2-D array (0,0)*/ +extern void putpix1(); /* Write one pixel to any data type 2-D array (1,1) */ +extern void addpix(); /* Add to one pixel in any data type 2-D array (0,0)*/ +extern void addpix1(); /* Add to one pixel in any data type 2-D array (1,1)*/ +extern void movepix(); /* Move one pixel value between two 2-D arrays (0,0) */ +extern void movepix1(); /* Move one pixel value between two 2-D arrays (1,1) */ +extern void getvec(); /* Read vector from a 2-D array */ +extern void putvec(); /* Write vector into a 2-D array */ +extern void fillvec(); /* Write constant into a vector */ +extern void fillvec1(); /* Write constant into a vector */ +extern void imswap(); /* Swap alternating bytes in a vector */ +extern void imswap2(); /* Swap bytes in a vector of 2-byte (short) integers */ +extern void imswap4(); /* Reverse bytes in a vector of 4-byte numbers */ +extern void imswap8(); /* Reverse bytes in a vector of 8-byte numbers */ +extern int imswapped(); /* Return 1 if machine byte order is not FITS order */ + +#endif /* imio_h_ */ + +/* May 31 1996 Use stream I/O for reading as well as writing + * Jun 12 1996 Add byte-swapping subroutines + * Aug 6 1996 Add MOVEPIX, HDEL and HCHANGE declarations + * + * May 27 1998 Split off imio subroutines to imio.h + + * Sep 27 1999 Add Fortran-indexed (1,1), not (0,0) image access *1() + * Sep 28 1999 Add addpix() + * + * Feb 27 2004 Add fillvec() + */ diff --git a/tksao/wcssubs/lin.c b/tksao/wcssubs/lin.c new file mode 100644 index 0000000..c46bf19 --- /dev/null +++ b/tksao/wcssubs/lin.c @@ -0,0 +1,448 @@ +/*============================================================================= +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* C routines which implement the FITS World Coordinate System (WCS) +* convention. +* +* Summary of routines +* ------------------- +* These utility routines apply the linear transformation defined by the WCS +* FITS header cards. There are separate routines for the image-to-pixel, +* linfwd(), and pixel-to-image, linrev(), transformations. +* +* An initialization routine, linset(), computes intermediate values from +* the transformation parameters but need not be called explicitly - see the +* explanation of lin.flag below. +* +* An auxiliary matrix inversion routine, matinv(), is included. It uses +* LU-triangular factorization with scaled partial pivoting. +* +* +* Initialization routine; linset() +* -------------------------------- +* Initializes members of a linprm data structure which hold intermediate +* values. Note that this routine need not be called directly; it will be +* invoked by linfwd() and linrev() if the "flag" structure member is +* anything other than a predefined magic value. +* +* Given and/or returned: +* lin linprm* Linear transformation parameters (see below). +* +* Function return value: +* int Error status +* 0: Success. +* 1: Memory allocation error. +* 2: PC matrix is singular. +* +* Forward transformation; linfwd() +* -------------------------------- +* Compute pixel coordinates from image coordinates. Note that where +* celestial coordinate systems are concerned the image coordinates +* correspond to (x,y) in the plane of projection, not celestial (lng,lat). +* +* Given: +* imgcrd const double[] +* Image (world) coordinate. +* +* Given and returned: +* lin linprm* Linear transformation parameters (see below). +* +* Returned: +* pixcrd d[] Pixel coordinate. +* +* Function return value: +* int Error status +* 0: Success. +* 1: The transformation is not invertible. +* +* Reverse transformation; linrev() +* -------------------------------- +* Compute image coordinates from pixel coordinates. Note that where +* celestial coordinate systems are concerned the image coordinates +* correspond to (x,y) in the plane of projection, not celestial (lng,lat). +* +* Given: +* pixcrd const double[] +* Pixel coordinate. +* +* Given and/or returned: +* lin linprm* Linear transformation parameters (see below). +* +* Returned: +* imgcrd d[] Image (world) coordinate. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Error. +* +* Linear transformation parameters +* -------------------------------- +* The linprm struct consists of the following: +* +* int flag +* This flag must be set to zero whenever any of the following members +* are set or modified. This signals the initialization routine, +* linset(), to recompute intermediaries. +* int naxis +* Number of image axes. +* double *crpix +* Pointer to the first element of an array of double containing the +* coordinate reference pixel, CRPIXn. +* double *pc +* Pointer to the first element of the PC (pixel coordinate) +* transformation matrix. The expected order is +* +* lin.pc = {PC1_1, PC1_2, PC2_1, PC2_2}; +* +* This may be conveniently constructed from a two-dimensional array +* via +* +* double m[2][2] = {{PC1_1, PC1_2}, +* {PC2_1, PC2_2}}; +* +* which is equivalent to, +* +* double m[2][2]; +* m[0][0] = PC1_1; +* m[0][1] = PC1_2; +* m[1][0] = PC2_1; +* m[1][1] = PC2_2; +* +* for which the storage order is +* +* PC1_1, PC1_2, PC2_1, PC2_2 +* +* so it would be legitimate to set lin.pc = *m. +* double *cdelt +* Pointer to the first element of an array of double containing the +* coordinate increments, CDELTn. +* +* The remaining members of the linprm struct are maintained by the +* initialization routine and should not be modified. +* +* double *piximg +* Pointer to the first element of the matrix containing the product +* of the CDELTn diagonal matrix and the PC matrix. +* double *imgpix +* Pointer to the first element of the inverse of the piximg matrix. +* +* linset allocates storage for the above arrays using malloc(). Note, +* however, that these routines do not free this storage so if a linprm +* variable has itself been malloc'd then these structure members must be +* explicitly freed before the linprm variable is free'd otherwise a memory +* leak will result. +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: lin.c,v 1.1.1.1 2016/03/30 20:00:02 joye Exp $ +*===========================================================================*/ + +#include <stdlib.h> +#include <math.h> +#include "wcslib.h" + +/* Map error number to error message for each function. */ +const char *linset_errmsg[] = { + 0, + "Memory allocation error", + "PC matrix is singular"}; + +const char *linfwd_errmsg[] = { + 0, + "Memory allocation error", + "PC matrix is singular"}; + +const char *linrev_errmsg[] = { + 0, + "Memory allocation error", + "PC matrix is singular"}; + +int linset(lin) + +struct linprm *lin; + +{ + int i, ij, j, mem, n; + + n = lin->naxis; + + /* Allocate memory for internal arrays. */ + mem = n * n * sizeof(double); + lin->piximg = (double*)malloc(mem); + if (lin->piximg == (double*)0) return 1; + + lin->imgpix = (double*)malloc(mem); + if (lin->imgpix == (double*)0) { + free(lin->piximg); + return 1; + } + + /* Compute the pixel-to-image transformation matrix. */ + for (i = 0, ij = 0; i < n; i++) { + for (j = 0; j < n; j++, ij++) { + lin->piximg[ij] = lin->cdelt[i] * lin->pc[ij]; + } + } + + /* Compute the image-to-pixel transformation matrix. */ + if (matinv(n, lin->piximg, lin->imgpix)) return 2; + + lin->flag = LINSET; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int linfwd(imgcrd, lin, pixcrd) + +const double imgcrd[]; +struct linprm *lin; +double pixcrd[]; + +{ + int i, ij, j, n; + + n = lin->naxis; + + if (lin->flag != LINSET) { + if (linset(lin)) return 1; + } + + for (i = 0, ij = 0; i < n; i++) { + pixcrd[i] = 0.0; + for (j = 0; j < n; j++, ij++) { + pixcrd[i] += lin->imgpix[ij] * imgcrd[j]; + } + } + + for (j = 0; j < n; j++) { + pixcrd[j] += lin->crpix[j]; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int linrev(pixcrd, lin, imgcrd) + +const double pixcrd[]; +struct linprm *lin; +double imgcrd[]; + +{ + int i, ij, j, n; + double temp; + + n = lin->naxis; + + if (lin->flag != LINSET) { + if (linset(lin)) return 1; + } + + for (i = 0; i < n; i++) { + imgcrd[i] = 0.0; + } + + for (j = 0; j < n; j++) { + temp = pixcrd[j] - lin->crpix[j]; + for (i = 0, ij = j; i < n; i++, ij+=n) { + imgcrd[i] += lin->piximg[ij] * temp; + } + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int matinv(n, mat, inv) + +const int n; +const double mat[]; +double inv[]; + +{ + register int i, ij, ik, j, k, kj, pj; + int itemp, mem, *mxl, *lxm, pivot; + double colmax, *lu, *rowmax, dtemp; + + + /* Allocate memory for internal arrays. */ + mem = n * sizeof(int); + if ((mxl = (int*)malloc(mem)) == (int*)0) return 1; + if ((lxm = (int*)malloc(mem)) == (int*)0) { + free(mxl); + return 1; + } + + mem = n * sizeof(double); + if ((rowmax = (double*)malloc(mem)) == (double*)0) { + free(mxl); + free(lxm); + return 1; + } + + mem *= n; + if ((lu = (double*)malloc(mem)) == (double*)0) { + free(mxl); + free(lxm); + free(rowmax); + return 1; + } + + + /* Initialize arrays. */ + for (i = 0, ij = 0; i < n; i++) { + /* Vector which records row interchanges. */ + mxl[i] = i; + + rowmax[i] = 0.0; + + for (j = 0; j < n; j++, ij++) { + dtemp = fabs(mat[ij]); + if (dtemp > rowmax[i]) rowmax[i] = dtemp; + + lu[ij] = mat[ij]; + } + + /* A row of zeroes indicates a singular matrix. */ + if (rowmax[i] == 0.0) { + free(mxl); + free(lxm); + free(rowmax); + free(lu); + return 2; + } + } + + + /* Form the LU triangular factorization using scaled partial pivoting. */ + for (k = 0; k < n; k++) { + /* Decide whether to pivot. */ + colmax = fabs(lu[k*n+k]) / rowmax[k]; + pivot = k; + + for (i = k+1; i < n; i++) { + ik = i*n + k; + dtemp = fabs(lu[ik]) / rowmax[i]; + if (dtemp > colmax) { + colmax = dtemp; + pivot = i; + } + } + + if (pivot > k) { + /* We must pivot, interchange the rows of the design matrix. */ + for (j = 0, pj = pivot*n, kj = k*n; j < n; j++, pj++, kj++) { + dtemp = lu[pj]; + lu[pj] = lu[kj]; + lu[kj] = dtemp; + } + + /* Amend the vector of row maxima. */ + dtemp = rowmax[pivot]; + rowmax[pivot] = rowmax[k]; + rowmax[k] = dtemp; + + /* Record the interchange for later use. */ + itemp = mxl[pivot]; + mxl[pivot] = mxl[k]; + mxl[k] = itemp; + } + + /* Gaussian elimination. */ + for (i = k+1; i < n; i++) { + ik = i*n + k; + + /* Nothing to do if lu[ik] is zero. */ + if (lu[ik] != 0.0) { + /* Save the scaling factor. */ + lu[ik] /= lu[k*n+k]; + + /* Subtract rows. */ + for (j = k+1; j < n; j++) { + lu[i*n+j] -= lu[ik]*lu[k*n+j]; + } + } + } + } + + + /* mxl[i] records which row of mat corresponds to row i of lu. */ + /* lxm[i] records which row of lu corresponds to row i of mat. */ + for (i = 0; i < n; i++) { + lxm[mxl[i]] = i; + } + + + /* Determine the inverse matrix. */ + for (i = 0, ij = 0; i < n; i++) { + for (j = 0; j < n; j++, ij++) { + inv[ij] = 0.0; + } + } + + for (k = 0; k < n; k++) { + inv[lxm[k]*n+k] = 1.0; + + /* Forward substitution. */ + for (i = lxm[k]+1; i < n; i++) { + for (j = lxm[k]; j < i; j++) { + inv[i*n+k] -= lu[i*n+j]*inv[j*n+k]; + } + } + + /* Backward substitution. */ + for (i = n-1; i >= 0; i--) { + for (j = i+1; j < n; j++) { + inv[i*n+k] -= lu[i*n+j]*inv[j*n+k]; + } + inv[i*n+k] /= lu[i*n+i]; + } + } + + free(mxl); + free(lxm); + free(rowmax); + free(lu); + + return 0; +} +/* Dec 20 1999 Doug Mink - Include wcslib.h, which includes lin.h + * + * Feb 15 2001 Doug Mink - Add comments for WCSLIB 2.6; no code changes + * Sep 19 2001 Doug Mink - Add above change to WCSLIB 2.7 code + * Nov 20 2001 Doug Mink - Always include stdlib.h + * + * Jan 15 2002 Bill Joye - Add ifdef so this compiles on MacOS/X + * + * Nov 18 2003 Doug Mink - Include stdlib.h instead of malloc.h + */ diff --git a/tksao/wcssubs/platepos.c b/tksao/wcssubs/platepos.c new file mode 100644 index 0000000..8479350 --- /dev/null +++ b/tksao/wcssubs/platepos.c @@ -0,0 +1,391 @@ +/*** File saoimage/wcslib/platepos.c + *** February 29, 2000 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1998-2002 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: platepos.c (Plate solution WCS conversion + * Purpose: Compute WCS from plate fit + * Subroutine: platepos() converts from pixel location to RA,Dec + * Subroutine: platepix() converts from RA,Dec to pixel location + + These functions are based on the astrmcal.c portion of GETIMAGE by + J. Doggett and the documentation distributed with the Digital Sky Survey. + +*/ + +#include <math.h> +#include <string.h> +#include <stdio.h> +#include "wcs.h" + +int +platepos (xpix, ypix, wcs, xpos, ypos) + +/* Routine to determine accurate position for pixel coordinates */ +/* returns 0 if successful otherwise 1 = angle too large for projection; */ +/* based on amdpos() from getimage */ + +/* Input: */ +double xpix; /* x pixel number (RA or long without rotation) */ +double ypix; /* y pixel number (dec or lat without rotation) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpos; /* Right ascension or longitude in degrees */ +double *ypos; /* Declination or latitude in degrees */ + +{ + double x, y, x2, y2, x3, y3, r2; + double xi, xir, eta, etar, raoff, ra, dec, ra0, dec0; + double twopi = 6.28318530717959; + double ctan, ccos; + int ncoeff1 = wcs->ncoeff1; + int ncoeff2 = wcs->ncoeff2; + + /* Ignore magnitude and color terms + double mag = 0.0; + double color = 0.0; */ + + /* Convert from pixels to millimeters */ + x = xpix - wcs->crpix[0]; + y = ypix - wcs->crpix[1]; + x2 = x * x; + y2 = y * y; + x3 = x * x2; + y3 = y * y2; + r2 = x2 + y2; + + /* Compute xi,eta coordinates in degrees from x,y and plate model */ + xi = wcs->x_coeff[ 0] + wcs->x_coeff[ 1]*x + + wcs->x_coeff[ 2]*y + wcs->x_coeff[ 3]*x2 + + wcs->x_coeff[ 4]*y2 + wcs->x_coeff[ 5]*x*y; + + if (ncoeff1 > 6) + xi = xi + wcs->x_coeff[ 6]*x3 + wcs->x_coeff[ 7]*y3; + + if (ncoeff1 > 8) { + xi = xi + wcs->x_coeff[ 8]*x2*y + wcs->x_coeff[ 9]*x*y2 + + wcs->x_coeff[10]*(r2) + wcs->x_coeff[11]*x*r2 + + wcs->x_coeff[12]*y*r2; + } + + eta = wcs->y_coeff[ 0] + wcs->y_coeff[ 1]*x + + wcs->y_coeff[ 2]*y + wcs->y_coeff[ 3]*x2 + + wcs->y_coeff[ 4]*y2 + wcs->y_coeff[ 5]*x*y; + + if (ncoeff2 > 6) + eta = eta + wcs->y_coeff[ 6]*x3 + wcs->y_coeff[ 7]*y3; + + if (ncoeff2 > 8) { + eta = eta + wcs->y_coeff[ 8]*x2*y + wcs->y_coeff[ 9]*y2*x + + wcs->y_coeff[10]*r2 + wcs->y_coeff[11]*x*r2 + + wcs->y_coeff[12]*y*r2; + } + + /* Convert to radians */ + xir = degrad (xi); + etar = degrad (eta); + + /* Convert to RA and Dec */ + ra0 = degrad (wcs->crval[0]); + dec0 = degrad (wcs->crval[1]); + ctan = tan (dec0); + ccos = cos (dec0); + raoff = atan2 (xir / ccos, 1.0 - etar * ctan); + ra = raoff + ra0; + if (ra < 0.0) ra = ra + twopi; + *xpos = raddeg (ra); + + dec = atan (cos (raoff) / ((1.0 - (etar * ctan)) / (etar + ctan))); + *ypos = raddeg (dec); + return 0; +} + + +int +platepix (xpos, ypos, wcs, xpix, ypix) + +/* Routine to determine pixel coordinates for sky position */ +/* returns 0 if successful otherwise 1 = angle too large for projection; */ +/* based on amdinv() from getimage */ + +/* Input: */ +double xpos; /* Right ascension or longitude in degrees */ +double ypos; /* Declination or latitude in degrees */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpix; /* x pixel number (RA or long without rotation) */ +double *ypix; /* y pixel number (dec or lat without rotation) */ + +{ + double xi,eta,x,y,xy,x2,y2,x2y,y2x,x3,y3,r2,dx,dy; + double tdec,ctan,ccos,traoff, craoff, etar, xir; + double f,fx,fy,g,gx,gy; + double ra0, dec0, ra, dec; + double tolerance = 0.0000005; + int max_iterations = 50; + int i; + int ncoeff1 = wcs->ncoeff1; + int ncoeff2 = wcs->ncoeff2; + + /* Convert RA and Dec in radians to standard coordinates on a plate */ + ra = degrad (xpos); + dec = degrad (ypos); + tdec = tan (dec); + ra0 = degrad (wcs->crval[0]); + dec0 = degrad (wcs->crval[1]); + ctan = tan (dec0); + ccos = cos (dec0); + traoff = tan (ra - ra0); + craoff = cos (ra - ra0); + etar = (1.0 - ctan * craoff / tdec) / (ctan + (craoff / tdec)); + xir = traoff * ccos * (1.0 - (etar * ctan)); + xi = raddeg (xir); + eta = raddeg (etar); + + /* Set initial value for x,y */ + x = xi * wcs->dc[0] + eta * wcs->dc[1]; + y = xi * wcs->dc[2] + eta * wcs->dc[3]; + + /* if (wcs->x_coeff[1] == 0.0) + x = xi - wcs->x_coeff[0]; + else + x = (xi - wcs->x_coeff[0]) / wcs->x_coeff[1]; + if (wcs->y_coeff[2] == 0.0) + y = eta - wcs->y_coeff[0]; + else + y = (eta - wcs->y_coeff[0]) / wcs->y_coeff[2]; */ + + /* Iterate by Newton's method */ + for (i = 0; i < max_iterations; i++) { + + /* X plate model */ + xy = x * y; + x2 = x * x; + y2 = y * y; + x3 = x2 * x; + y3 = y2 * y; + x2y = x2 * y; + y2x = y2 * x; + r2 = x2 + y2; + + f = wcs->x_coeff[0] + wcs->x_coeff[1]*x + + wcs->x_coeff[2]*y + wcs->x_coeff[3]*x2 + + wcs->x_coeff[4]*y2 + wcs->x_coeff[5]*xy; + + /* Derivative of X model wrt x */ + fx = wcs->x_coeff[1] + wcs->x_coeff[3]*2.0*x + + wcs->x_coeff[5]*y; + + /* Derivative of X model wrt y */ + fy = wcs->x_coeff[2] + wcs->x_coeff[4]*2.0*y + + wcs->x_coeff[5]*x; + + if (ncoeff1 > 6) { + f = f + wcs->x_coeff[6]*x3 + wcs->x_coeff[7]*y3; + fx = fx + wcs->x_coeff[6]*3.0*x2; + fy = fy + wcs->x_coeff[7]*3.0*y2; + } + + if (ncoeff1 > 8) { + f = f + + wcs->x_coeff[8]*x2y + wcs->x_coeff[9]*y2x + + wcs->x_coeff[10]*r2 + wcs->x_coeff[11]*x*r2 + + wcs->x_coeff[12]*y*r2; + + fx = fx + wcs->x_coeff[8]*2.0*xy + + wcs->x_coeff[9]*y2 + + wcs->x_coeff[10]*2.0*x + + wcs->x_coeff[11]*(3.0*x2+y2) + + wcs->x_coeff[12]*2.0*xy; + + fy = fy + wcs->x_coeff[8]*x2 + + wcs->x_coeff[9]*2.0*xy + + wcs->x_coeff[10]*2.0*y + + wcs->x_coeff[11]*2.0*xy + + wcs->x_coeff[12]*(3.0*y2+x2); + } + + /* Y plate model */ + g = wcs->y_coeff[0] + wcs->y_coeff[1]*x + + wcs->y_coeff[2]*y + wcs->y_coeff[3]*x2 + + wcs->y_coeff[4]*y2 + wcs->y_coeff[5]*xy; + + /* Derivative of Y model wrt x */ + gx = wcs->y_coeff[1] + wcs->y_coeff[3]*2.0*x + + wcs->y_coeff[5]*y; + + /* Derivative of Y model wrt y */ + gy = wcs->y_coeff[2] + wcs->y_coeff[4]*2.0*y + + wcs->y_coeff[5]*x; + + if (ncoeff2 > 6) { + g = g + wcs->y_coeff[6]*x3 + wcs->y_coeff[7]*y3; + gx = gx + wcs->y_coeff[6]*3.0*x2; + gy = gy + wcs->y_coeff[7]*3.0*y2; + } + + if (ncoeff2 > 8) { + g = g + + wcs->y_coeff[8]*x2y + wcs->y_coeff[9]*y2x + + wcs->y_coeff[10]*r2 + wcs->y_coeff[11]*x*r2 + + wcs->y_coeff[12]*y*r2; + + gx = gx + wcs->y_coeff[8]*2.0*xy + + wcs->y_coeff[9]*y2 + + wcs->y_coeff[10]*2.0*x + + wcs->y_coeff[11]*(3.0*x2+y2) + + wcs->y_coeff[12]*2.0*xy; + + gy = gy + wcs->y_coeff[8]*x2 + + wcs->y_coeff[9]*2.0*xy + + wcs->y_coeff[10]*2.0*y + + wcs->y_coeff[11]*2.0*xy + + wcs->y_coeff[12]*(3.0*y2+x2); + } + + f = f - xi; + g = g - eta; + dx = ((-f * gy) + (g * fy)) / ((fx * gy) - (fy * gx)); + dy = ((-g * fx) + (f * gx)) / ((fx * gy) - (fy * gx)); + x = x + dx; + y = y + dy; + if ((fabs(dx) < tolerance) && (fabs(dy) < tolerance)) break; + } + + /* Convert from plate pixels to image pixels */ + *xpix = x + wcs->crpix[0]; + *ypix = y + wcs->crpix[1]; + + /* If position is off of the image, return offscale code */ + if (*xpix < 0.5 || *xpix > wcs->nxpix+0.5) + return -1; + if (*ypix < 0.5 || *ypix > wcs->nypix+0.5) + return -1; + + return 0; +} + + +/* Set plate fit coefficients in structure from arguments */ +int +SetPlate (wcs, ncoeff1, ncoeff2, coeff) + +struct WorldCoor *wcs; /* World coordinate system structure */ +int ncoeff1; /* Number of coefficients for x */ +int ncoeff2; /* Number of coefficients for y */ +double *coeff; /* Plate fit coefficients */ + +{ + int i; + + if (nowcs (wcs) || (ncoeff1 < 1 && ncoeff2 < 1)) + return 1; + + wcs->ncoeff1 = ncoeff1; + wcs->ncoeff2 = ncoeff2; + wcs->prjcode = WCS_PLT; + + for (i = 0; i < 20; i++) { + if (i < ncoeff1) + wcs->x_coeff[i] = coeff[i]; + else + wcs->x_coeff[i] = 0.0; + } + + for (i = 0; i < 20; i++) { + if (i < ncoeff2) + wcs->y_coeff[i] = coeff[ncoeff1+i]; + else + wcs->y_coeff[i] = 0.0; + } + return 0; +} + + +/* Return plate fit coefficients from structure in arguments */ +int +GetPlate (wcs, ncoeff1, ncoeff2, coeff) + +struct WorldCoor *wcs; /* World coordinate system structure */ +int *ncoeff1; /* Number of coefficients for x */ +int *ncoeff2; /* Number of coefficients for y) */ +double *coeff; /* Plate fit coefficients */ + +{ + int i; + + if (nowcs (wcs)) + return 1; + + *ncoeff1 = wcs->ncoeff1; + *ncoeff2 = wcs->ncoeff2; + + for (i = 0; i < *ncoeff1; i++) + coeff[i] = wcs->x_coeff[i]; + + for (i = 0; i < *ncoeff2; i++) + coeff[*ncoeff1+i] = wcs->y_coeff[i]; + + return 0; +} + + +/* Set FITS header plate fit coefficients from structure */ +void +SetFITSPlate (header, wcs) + +char *header; /* Image FITS header */ +struct WorldCoor *wcs; /* WCS structure */ + +{ + char keyword[16]; + int i; + + for (i = 0; i < wcs->ncoeff1; i++) { + sprintf (keyword,"CO1_%d",i+1); + hputnr8 (header, keyword, -15, wcs->x_coeff[i]); + } + for (i = 0; i < wcs->ncoeff2; i++) { + sprintf (keyword,"CO2_%d",i+1); + hputnr8 (header, keyword, -15, wcs->y_coeff[i]); + } + return; +} + +/* Mar 27 1998 New subroutines for direct image pixel <-> sky polynomials + * Apr 10 1998 Make terms identical for both x and y polynomials + * Apr 10 1998 Allow different numbers of coefficients for x and y + * Apr 16 1998 Drom NCOEFF header parameter + * Apr 28 1998 Change projection flags to WCS_* + * Sep 10 1998 Check for xc1 and yc2 divide by zero after Allen Harris, SAO + * + * Oct 21 1999 Drop unused variables after lint + * + * Feb 29 2000 Use inverse CD matrix to get initial X,Y in platepix() + * as suggested by Paolo Montegriffo from Bologna Ast. Obs. + */ diff --git a/tksao/wcssubs/poly.c b/tksao/wcssubs/poly.c new file mode 100644 index 0000000..f0f46cb --- /dev/null +++ b/tksao/wcssubs/poly.c @@ -0,0 +1,914 @@ + /* + poly.c + +*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +* +* Part of: A program using Polynomials +* +* Author: E.BERTIN (IAP) +* +* Contents: Polynomial fitting +* +* Last modify: 08/03/2005 +* +*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +*/ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "wcslib.h" + + +#define QCALLOC(ptr, typ, nel) \ + {if (!(ptr = (typ *)calloc((size_t)(nel),sizeof(typ)))) \ + qerror("Not enough memory for ", \ + #ptr " (" #nel " elements) !");;} + +#define QMALLOC(ptr, typ, nel) \ + {if (!(ptr = (typ *)malloc((size_t)(nel)*sizeof(typ)))) \ + qerror("Not enough memory for ", \ + #ptr " (" #nel " elements) !");;} + +/********************************* qerror ************************************/ +/* +I hope it will never be used! +*/ +void qerror(char *msg1, char *msg2) + { + fprintf(stderr, "\n> %s%s\n\n",msg1,msg2); + exit(-1); + } + + +/****** poly_init ************************************************************ +PROTO polystruct *poly_init(int *group, int ndim, int *degree, int ngroup) +PURPOSE Allocate and initialize a polynom structure. +INPUT 1D array containing the group for each parameter, + number of dimensions (parameters), + 1D array with the polynomial degree for each group, + number of groups. +OUTPUT polystruct pointer. +NOTES -. +AUTHOR E. Bertin (IAP) +VERSION 08/03/2003 + ***/ +polystruct *poly_init(int *group, int ndim, int *degree, int ngroup) + { + void qerror(char *msg1, char *msg2); + polystruct *poly; + char str[512]; + int nd[POLY_MAXDIM]; + int *groupt, + d,g,n,num,den; + + QCALLOC(poly, polystruct, 1); + if ((poly->ndim=ndim) > POLY_MAXDIM) + { + sprintf(str, "The dimensionality of the polynom (%d) exceeds the maximum\n" + "allowed one (%d)", ndim, POLY_MAXDIM); + qerror("*Error*: ", str); + } + + if (ndim) + QMALLOC(poly->group, int, poly->ndim); + for (groupt=poly->group, d=ndim; d--;) + *(groupt++) = *(group++)-1; + + poly->ngroup = ngroup; + if (ngroup) + { + group = poly->group; /* Forget the original *group */ + + QMALLOC(poly->degree, int, poly->ngroup); + +/*-- Compute the number of context parameters for each group */ + memset(nd, 0, ngroup*sizeof(int)); + for (d=0; d<ndim; d++) + { + if ((g=group[d])>=ngroup) + qerror("*Error*: polynomial GROUP out of range", ""); + nd[g]++; + } + } + +/* Compute the total number of coefficients */ + poly->ncoeff = 1; + for (g=0; g<ngroup; g++) + { + if ((d=poly->degree[g]=*(degree++))>POLY_MAXDEGREE) + { + sprintf(str, "The degree of the polynom (%d) exceeds the maximum\n" + "allowed one (%d)", poly->degree[g], POLY_MAXDEGREE); + qerror("*Error*: ", str); + } + +/*-- There are (n+d)!/(n!d!) coeffs per group, that is Prod_(i<=d) (n+i)/i */ + for (num=den=1, n=nd[g]; d; num*=(n+d), den*=d--); + poly->ncoeff *= num/den; + } + + QMALLOC(poly->basis, double, poly->ncoeff); + QCALLOC(poly->coeff, double, poly->ncoeff); + + return poly; + } + + +/****** poly_end ************************************************************* +PROTO void poly_end(polystruct *poly) +PURPOSE Free a polynom structure and everything it contains. +INPUT polystruct pointer. +OUTPUT -. +NOTES -. +AUTHOR E. Bertin (IAP, Leiden observatory & ESO) +VERSION 09/04/2000 + ***/ +void poly_end(polystruct *poly) + { + if (poly) + { + free(poly->coeff); + free(poly->basis); + free(poly->degree); + free(poly->group); + free(poly); + } + } + + +/****** poly_func ************************************************************ +PROTO double poly_func(polystruct *poly, double *pos) +PURPOSE Evaluate a multidimensional polynom. +INPUT polystruct pointer, + pointer to the 1D array of input vector data. +OUTPUT Polynom value. +NOTES Values of the basis functions are updated in poly->basis. +AUTHOR E. Bertin (IAP) +VERSION 03/03/2004 + ***/ +double poly_func(polystruct *poly, double *pos) + { + double xpol[POLY_MAXDIM+1]; + double *post, *xpolt, *basis, *coeff, xval; + long double val; + int expo[POLY_MAXDIM+1], gexpo[POLY_MAXDIM+1]; + int *expot, *degree,*degreet, *group,*groupt, *gexpot, + d,g,t, ndim; + +/* Prepare the vectors and counters */ + ndim = poly->ndim; + basis = poly->basis; + coeff = poly->coeff; + group = poly->group; + degree = poly->degree; + if (ndim) + { + for (xpolt=xpol, expot=expo, post=pos, d=ndim; --d;) + { + *(++xpolt) = 1.0; + *(++expot) = 0; + } + for (gexpot=gexpo, degreet=degree, g=poly->ngroup; g--;) + *(gexpot++) = *(degreet++); + if (gexpo[*group]) + gexpo[*group]--; + } + +/* The constant term is handled separately */ + val = *(coeff++); + *(basis++) = 1.0; + *expo = 1; + *xpol = *pos; + +/* Compute the rest of the polynom */ + for (t=poly->ncoeff; --t; ) + { +/*-- xpol[0] contains the current product of the x^n's */ + val += (*(basis++)=*xpol)**(coeff++); +/*-- A complex recursion between terms of the polynom speeds up computations */ +/*-- Not too good for roundoff errors (prefer Horner's), but much easier for */ +/*-- multivariate polynomials: this is why we use a long double accumulator */ + post = pos; + groupt = group; + expot = expo; + xpolt = xpol; + for (d=0; d<ndim; d++, groupt++) + if (gexpo[*groupt]--) + { + ++*(expot++); + xval = (*(xpolt--) *= *post); + while (d--) + *(xpolt--) = xval; + break; + } + else + { + gexpo[*groupt] = *expot; + *(expot++) = 0; + *(xpolt++) = 1.0; + post++; + } + } + + return (double)val; + } + + +/****** poly_fit ************************************************************* +PROTO double poly_fit(polystruct *poly, double *x, double *y, double *w, + int ndata, double *extbasis) +PURPOSE Least-Square fit of a multidimensional polynom to weighted data. +INPUT polystruct pointer, + pointer to the (pseudo)2D array of inputs to basis functions, + pointer to the 1D array of data values, + pointer to the 1D array of data weights, + number of data points, + pointer to a (pseudo)2D array of computed basis function values. +OUTPUT Chi2 of the fit. +NOTES If different from NULL, extbasis can be provided to store the + values of the basis functions. If x==NULL and extbasis!=NULL, the + precomputed basis functions stored in extbasis are used (which saves + CPU). If w is NULL, all points are given identical weight. +AUTHOR E. Bertin (IAP, Leiden observatory & ESO) +VERSION 08/03/2005 + ***/ +void poly_fit(polystruct *poly, double *x, double *y, double *w, int ndata, + double *extbasis) + { + void qerror(char *msg1, char *msg2); + double /*offset[POLY_MAXDIM],*/x2[POLY_MAXDIM], + *alpha,*alphat, *beta,*betat, *basis,*basis1,*basis2, *coeff, + *extbasist,*xt, + val,wval,yval; + int ncoeff, ndim, matsize, + d,i,j,n; + + if (!x && !extbasis) + qerror("*Internal Error*: One of x or extbasis should be " + "different from NULL\nin ", "poly_func()"); + ncoeff = poly->ncoeff; + ndim = poly->ndim; + matsize = ncoeff*ncoeff; + basis = poly->basis; + extbasist = extbasis; + QCALLOC(alpha, double, matsize); + QCALLOC(beta, double, ncoeff); + +/* Subtract an average offset to maintain precision (droped for now ) */ +/* + if (x) + { + for (d=0; d<ndim; d++) + offset[d] = 0.0; + xt = x; + for (n=ndata; n--;) + for (d=0; d<ndim; d++) + offset[d] += *(xt++); + for (d=0; d<ndim; d++) + offset[d] /= (double)ndata; + } +*/ +/* Build the covariance matrix */ + xt = x; + for (n=ndata; n--;) + { + if (x) + { +/*---- If x!=NULL, compute the basis functions */ + for (d=0; d<ndim; d++) + x2[d] = *(xt++)/* - offset[d]*/; + poly_func(poly, x2); +/*---- If, in addition, extbasis is provided, then fill it */ + if (extbasis) + for (basis1=basis,j=ncoeff; j--;) + *(extbasist++) = *(basis1++); + } + else +/*---- If x==NULL, then rely on pre-computed basis functions */ + for (basis1=basis,j=ncoeff; j--;) + *(basis1++) = *(extbasist++); + + basis1 = basis; + wval = w? *(w++) : 1.0; + yval = *(y++); + betat = beta; + alphat = alpha; + for (j=ncoeff; j--;) + { + val = *(basis1++)*wval; + *(betat++) += val*yval; + for (basis2=basis,i=ncoeff; i--;) + *(alphat++) += val**(basis2++); + } + } + +/* Solve the system */ + poly_solve(alpha,beta,ncoeff); + + free(alpha); + +/* Now fill the coeff array with the result of the fit */ + betat = beta; + coeff = poly->coeff; + for (j=ncoeff; j--;) + *(coeff++) = *(betat++); +/* + poly_addcste(poly, offset); +*/ + free(beta); + + return; + } + + +/****** poly_addcste ********************************************************* +PROTO void poly_addcste(polystruct *poly, double *cste) +PURPOSE Modify matrix coefficients to mimick the effect of adding a cst to + the input of a polynomial. +INPUT Pointer to the polynomial structure, + Pointer to the vector of cst. +OUTPUT -. +NOTES Requires quadruple-precision. **For the time beeing, this function + returns completely wrong results!!** +AUTHOR E. Bertin (IAP) +VERSION 03/03/2004 + ***/ +void poly_addcste(polystruct *poly, double *cste) + { + long double *acoeff; + double *coeff,*mcoeff,*mcoefft, + val; + int *mpowers,*powers,*powerst,*powerst2, + i,j,n,p, denum, flag, maxdegree, ncoeff, ndim; + + ncoeff = poly->ncoeff; + ndim = poly->ndim; + maxdegree = 0; + for (j=0; j<poly->ngroup; j++) + if (maxdegree < poly->degree[j]) + maxdegree = poly->degree[j]; + maxdegree++; /* Actually we need maxdegree+1 terms */ + QCALLOC(acoeff, long double, ncoeff); + QCALLOC(mcoeff, double, ndim*maxdegree); + QCALLOC(mpowers, int, ndim); + mcoefft = mcoeff; /* To avoid gcc -Wall warnings */ + powerst = powers = poly_powers(poly); + coeff = poly->coeff; + for (i=0; i<ncoeff; i++) + { + for (j=0; j<ndim; j++) + { + mpowers[j] = n = *(powerst++); + mcoefft = mcoeff+j*maxdegree+n; + denum = 1; + val = 1.0; + for (p=n+1; p--;) + { + *(mcoefft--) = val; + val *= (cste[j]*(n--))/(denum++); /* This is C_n^p X^(n-p) */ + } + } +/*-- Update all valid coefficients */ + powerst2 = powers; + for (p=0; p<ncoeff; p++) + { +/*---- Check that this combination of powers is included in the series above */ + flag = 0; + for (j=0; j<ndim; j++) + if (mpowers[j] < powerst2[j]) + { + flag = 1; + powerst2 += ndim; + break; + } + if (flag == 1) + continue; + val = 1.0; + mcoefft = mcoeff; + for (j=ndim; j--; mcoefft += maxdegree) + val *= mcoefft[*(powerst2++)]; + acoeff[i] += val*coeff[p]; +/* +printf("%g \n", val); +*/ + } + } + +/* Add the new coefficients to the previous ones */ + + for (i=0; i<ncoeff; i++) +{ +/* +printf("%g %g\n", coeff[i], (double)acoeff[i]); +*/ + coeff[i] = (double)acoeff[i]; +} + + free(acoeff); + free(mcoeff); + free(mpowers); + free(powers); + + return; + } + +/****** poly_solve ************************************************************ +PROTO void poly_solve(double *a, double *b, int n) +PURPOSE Solve a system of linear equations, using Cholesky decomposition or + SVD (if the former fails due to hidden correlation between variables). +INPUT Pointer to the (pseudo 2D) matrix of coefficients, + pointer to the 1D column vector, + matrix size. +OUTPUT -. +NOTES -. +AUTHOR E. Bertin (IAP, Leiden observatory & ESO) +VERSION 21/09/2004 + ***/ +void poly_solve(double *a, double *b, int n) + { + double *vmat,*wmat; + + if (cholsolve(a,b,n)) + { + QMALLOC(vmat, double, n*n); + QMALLOC(wmat, double, n); + svdsolve(a, b, n,n, vmat,wmat); + free(vmat); + free(wmat); + } + + return; + } + +/****** cholsolve ************************************************************* +PROTO void cholsolve(double *a, double *b, int n) +PURPOSE Solve a system of linear equations, using Cholesky decomposition. +INPUT Pointer to the (pseudo 2D) matrix of coefficients, + pointer to the 1D column vector, + matrix size. +OUTPUT -1 if the matrix is not positive-definite, 0 otherwise. +NOTES Based on Numerical Recipes, 2nd ed. (Chap 2.9). The matrix of + coefficients must be symmetric and positive definite. +AUTHOR E. Bertin (IAP, Leiden observatory & ESO) +VERSION 28/10/2003 + ***/ +int cholsolve(double *a, double *b, int n) + { + void qerror(char *msg1, char *msg2); + double *p, *x, sum; + int i,j,k; + +/* Allocate memory to store the diagonal elements */ + QMALLOC(p, double, n); + +/* Cholesky decomposition */ + for (i=0; i<n; i++) + for (j=i; j<n; j++) + { + for (sum=a[i*n+j],k=i-1; k>=0; k--) + sum -= a[i*n+k]*a[j*n+k]; + if (i==j) + { + if (sum <= 0.0) + { + free(p); + return -1; + } + p[i] = sqrt(sum); + } + else + a[j*n+i] = sum/p[i]; + } + +/* Solve the system */ + x = b; /* Just to save memory: the solution replaces b */ + for (i=0; i<n; i++) + { + for (sum=b[i],k=i-1; k>=0; k--) + sum -= a[i*n+k]*x[k]; + x[i] = sum/p[i]; + } + + for (i=n-1; i>=0; i--) + { + for (sum=x[i],k=i+1; k<n; k++) + sum -= a[k*n+i]*x[k]; + x[i] = sum/p[i]; + } + + free(p); + + return 0; + } + + +/****** svdsolve ************************************************************* +PROTO void svdsolve(double *a, double *b, int m, int n, double *vmat, + double *wmat) +PURPOSE General least-square fit A.x = b, based on Singular Value + Decomposition (SVD). + Loosely adapted from Numerical Recipes in C, 2nd Ed. (p. 671). +INPUT Pointer to the (pseudo 2D) matrix of coefficients, + pointer to the 1D column vector (replaced by solution in output), + number of matrix rows, + number of matrix columns, + pointer to the (pseudo 2D) SVD matrix, + pointer to the diagonal (1D) matrix of singular values. +OUTPUT -. +NOTES Loosely adapted from Numerical Recipes in C, 2nd Ed. (p. 671). The a + and v matrices are transposed with respect to the N.R. convention. +AUTHOR E. Bertin (IAP) +VERSION 26/12/2003 + ***/ +void svdsolve(double *a, double *b, int m, int n, double *vmat, double *wmat) + { +#define MAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\ + (maxarg1) : (maxarg2)) +#define PYTHAG(a,b) ((at=fabs(a)) > (bt=fabs(b)) ? \ + (ct=bt/at,at*sqrt(1.0+ct*ct)) \ + : (bt ? (ct=at/bt,bt*sqrt(1.0+ct*ct)): 0.0)) +#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a)) +#define TOL 1.0e-11 + void qerror(char *msg1, char *msg2); + + int flag,i,its,j,jj,k,l,mmi,nm, nml; + double *w,*ap,*ap0,*ap1,*ap10,*rv1p,*vp,*vp0,*vp1,*vp10, + *bp,*tmpp, *rv1,*tmp, *sol, + c,f,h,s,x,y,z, + anorm, g, scale, + at,bt,ct,maxarg1,maxarg2, + thresh, wmax; + + anorm = g = scale = 0.0; + if (m < n) + qerror("*Error*: Not enough rows for solving the system ", "in svdfit()"); + + sol = b; /* The solution overwrites the input column matrix */ + QMALLOC(rv1, double, n); + QMALLOC(tmp, double, n); + l = nm = nml = 0; /* To avoid gcc -Wall warnings */ + for (i=0;i<n;i++) + { + l = i+1; + nml = n-l; + rv1[i] = scale*g; + g = s = scale = 0.0; + if ((mmi = m - i) > 0) + { + ap = ap0 = a+i*(m+1); + for (k=mmi;k--;) + scale += fabs(*(ap++)); + if (scale) + { + for (ap=ap0,k=mmi; k--; ap++) + { + *ap /= scale; + s += *ap**ap; + } + f = *ap0; + g = -SIGN(sqrt(s),f); + h = f*g-s; + *ap0 = f-g; + ap10 = a+l*m+i; + for (j=nml;j--; ap10+=m) + { + for (s=0.0,ap=ap0,ap1=ap10,k=mmi; k--;) + s += *(ap1++)**(ap++); + f = s/h; + for (ap=ap0,ap1=ap10,k=mmi; k--;) + *(ap1++) += f**(ap++); + } + for (ap=ap0,k=mmi; k--;) + *(ap++) *= scale; + } + } + wmat[i] = scale*g; + g = s = scale = 0.0; + if (i < m && i+1 != n) + { + ap = ap0 = a+i+m*l; + for (k=nml;k--; ap+=m) + scale += fabs(*ap); + if (scale) + { + for (ap=ap0,k=nml;k--; ap+=m) + { + *ap /= scale; + s += *ap**ap; + } + f=*ap0; + g = -SIGN(sqrt(s),f); + h=f*g-s; + *ap0=f-g; + rv1p = rv1+l; + for (ap=ap0,k=nml;k--; ap+=m) + *(rv1p++) = *ap/h; + ap10 = a+l+m*l; + for (j=m-l; j--; ap10++) + { + for (s=0.0,ap=ap0,ap1=ap10,k=nml; k--; ap+=m,ap1+=m) + s += *ap1**ap; + rv1p = rv1+l; + for (ap1=ap10,k=nml;k--; ap1+=m) + *ap1 += s**(rv1p++); + } + for (ap=ap0,k=nml;k--; ap+=m) + *ap *= scale; + } + } + anorm=MAX(anorm,(fabs(wmat[i])+fabs(rv1[i]))); + } + + for (i=n-1;i>=0;i--) + { + if (i < n-1) + { + if (g) + { + ap0 = a+l*m+i; + vp0 = vmat+i*n+l; + vp10 = vmat+l*n+l; + g *= *ap0; + for (ap=ap0,vp=vp0,j=nml; j--; ap+=m) + *(vp++) = *ap/g; + for (j=nml; j--; vp10+=n) + { + for (s=0.0,ap=ap0,vp1=vp10,k=nml; k--; ap+=m) + s += *ap**(vp1++); + for (vp=vp0,vp1=vp10,k=nml; k--;) + *(vp1++) += s**(vp++); + } + } + vp = vmat+l*n+i; + vp1 = vmat+i*n+l; + for (j=nml; j--; vp+=n) + *vp = *(vp1++) = 0.0; + } + vmat[i*n+i]=1.0; + g=rv1[i]; + l=i; + nml = n-l; + } + + for (i=(m<n?m:n); --i>=0;) + { + l=i+1; + nml = n-l; + mmi=m-i; + g=wmat[i]; + ap0 = a+i*m+i; + ap10 = ap0 + m; + for (ap=ap10,j=nml;j--;ap+=m) + *ap=0.0; + if (g) + { + g=1.0/g; + for (j=nml;j--; ap10+=m) + { + for (s=0.0,ap=ap0,ap1=ap10,k=mmi; --k;) + s += *(++ap)**(++ap1); + f = (s/(*ap0))*g; + for (ap=ap0,ap1=ap10,k=mmi;k--;) + *(ap1++) += f**(ap++); + } + for (ap=ap0,j=mmi;j--;) + *(ap++) *= g; + } + else + for (ap=ap0,j=mmi;j--;) + *(ap++)=0.0; + ++(*ap0); + } + + for (k=n; --k>=0;) + { + for (its=0;its<100;its++) + { + flag=1; + for (l=k;l>=0;l--) + { + nm=l-1; + if (fabs(rv1[l])+anorm == anorm) + { + flag=0; + break; + } + if (fabs(wmat[nm])+anorm == anorm) + break; + } + if (flag) + { + c=0.0; + s=1.0; + ap0 = a+nm*m; + ap10 = a+l*m; + for (i=l; i<=k; i++,ap10+=m) + { + f=s*rv1[i]; + if (fabs(f)+anorm == anorm) + break; + g=wmat[i]; + h=PYTHAG(f,g); + wmat[i]=h; + h=1.0/h; + c=g*h; + s=(-f*h); + for (ap=ap0,ap1=ap10,j=m; j--;) + { + z = *ap1; + y = *ap; + *(ap++) = y*c+z*s; + *(ap1++) = z*c-y*s; + } + } + } + z=wmat[k]; + if (l == k) + { + if (z < 0.0) + { + wmat[k] = -z; + vp = vmat+k*n; + for (j=n; j--; vp++) + *vp = (-*vp); + } + break; + } + if (its == 99) + qerror("*Error*: No convergence in 100 SVD iterations ", + "in svdfit()"); + x=wmat[l]; + nm=k-1; + y=wmat[nm]; + g=rv1[nm]; + h=rv1[k]; + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g=PYTHAG(f,1.0); + f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x; + c=s=1.0; + ap10 = a+l*m; + vp10 = vmat+l*n; + for (j=l;j<=nm;j++,ap10+=m,vp10+=n) + { + i=j+1; + g=rv1[i]; + y=wmat[i]; + h=s*g; + g=c*g; + z=PYTHAG(f,h); + rv1[j]=z; + c=f/z; + s=h/z; + f=x*c+g*s; + g=g*c-x*s; + h=y*s; + y=y*c; + for (vp=(vp1=vp10)+n,jj=n; jj--;) + { + z = *vp; + x = *vp1; + *(vp1++) = x*c+z*s; + *(vp++) = z*c-x*s; + } + z=PYTHAG(f,h); + wmat[j]=z; + if (z) + { + z=1.0/z; + c=f*z; + s=h*z; + } + f=c*g+s*y; + x=c*y-s*g; + for (ap=(ap1=ap10)+m,jj=m; jj--;) + { + z = *ap; + y = *ap1; + *(ap1++) = y*c+z*s; + *(ap++) = z*c-y*s; + } + } + rv1[l]=0.0; + rv1[k]=f; + wmat[k]=x; + } + } + + wmax=0.0; + w = wmat; + for (j=n;j--; w++) + if (*w > wmax) + wmax=*w; + thresh=TOL*wmax; + w = wmat; + for (j=n;j--; w++) + if (*w < thresh) + *w = 0.0; + + w = wmat; + ap = a; + tmpp = tmp; + for (j=n; j--; w++) + { + s=0.0; + if (*w) + { + bp = b; + for (i=m; i--;) + s += *(ap++)**(bp++); + s /= *w; + } + else + ap += m; + *(tmpp++) = s; + } + + vp0 = vmat; + for (j=0; j<n; j++,vp0++) + { + s=0.0; + tmpp = tmp; + for (vp=vp0,jj=n; jj--; vp+=n) + s += *vp**(tmpp++); + sol[j]=s; + } +/* Free temporary arrays */ + free(tmp); + free(rv1); + + return; + } + +#undef SIGN +#undef MAX +#undef PYTHAG +#undef TOL + +/****** poly_powers *********************************************************** +PROTO int *poly_powers(polystruct *poly) +PURPOSE Return an array of powers of polynom terms +INPUT polystruct pointer, +OUTPUT Pointer to an array of polynom powers (int *), (ncoeff*ndim numbers). +NOTES The returned pointer is mallocated. +AUTHOR E. Bertin (IAP) +VERSION 23/10/2003 + ***/ +int *poly_powers(polystruct *poly) + { + int expo[POLY_MAXDIM+1], gexpo[POLY_MAXDIM+1]; + int *expot, *degree,*degreet, *group,*groupt, *gexpot, + *powers, *powerst, + d,g,t, ndim; + +/* Prepare the vectors and counters */ + ndim = poly->ndim; + group = poly->group; + degree = poly->degree; + QMALLOC(powers, int, ndim*poly->ncoeff); + if (ndim) + { + for (expot=expo, d=ndim; --d;) + *(++expot) = 0; + for (gexpot=gexpo, degreet=degree, g=poly->ngroup; g--;) + *(gexpot++) = *(degreet++); + if (gexpo[*group]) + gexpo[*group]--; + } + +/* The constant term is handled separately */ + powerst = powers; + for (d=0; d<ndim; d++) + *(powerst++) = 0; + *expo = 1; + +/* Compute the rest of the polynom */ + for (t=poly->ncoeff; --t; ) + { + for (d=0; d<ndim; d++) + *(powerst++) = expo[d]; +/*-- A complex recursion between terms of the polynom speeds up computations */ + groupt = group; + expot = expo; + for (d=0; d<ndim; d++, groupt++) + if (gexpo[*groupt]--) + { + ++*(expot++); + break; + } + else + { + gexpo[*groupt] = *expot; + *(expot++) = 0; + } + } + + return powers; + } + diff --git a/tksao/wcssubs/proj.c b/tksao/wcssubs/proj.c new file mode 100644 index 0000000..ff4e7f6 --- /dev/null +++ b/tksao/wcssubs/proj.c @@ -0,0 +1,4527 @@ +/*============================================================================ +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* C implementation of the spherical map projections recognized by the FITS +* "World Coordinate System" (WCS) convention. +* +* Summary of routines +* ------------------- +* Each projection is implemented via separate functions for the forward, +* *fwd(), and reverse, *rev(), transformation. +* +* Initialization routines, *set(), compute intermediate values from the +* projection parameters but need not be called explicitly - see the +* explanation of prj.flag below. +* +* prjset prjfwd prjrev Driver routines (see below). +* +* azpset azpfwd azprev AZP: zenithal/azimuthal perspective +* szpset szpfwd szprev SZP: slant zenithal perspective +* tanset tanfwd tanrev TAN: gnomonic +* stgset stgfwd stgrev STG: stereographic +* sinset sinfwd sinrev SIN: orthographic/synthesis +* arcset arcfwd arcrev ARC: zenithal/azimuthal equidistant +* zpnset zpnfwd zpnrev ZPN: zenithal/azimuthal polynomial +* zeaset zeafwd zearev ZEA: zenithal/azimuthal equal area +* airset airfwd airrev AIR: Airy +* cypset cypfwd cyprev CYP: cylindrical perspective +* ceaset ceafwd cearev CEA: cylindrical equal area +* carset carfwd carrev CAR: Cartesian +* merset merfwd merrev MER: Mercator +* sflset sflfwd sflrev SFL: Sanson-Flamsteed +* parset parfwd parrev PAR: parabolic +* molset molfwd molrev MOL: Mollweide +* aitset aitfwd aitrev AIT: Hammer-Aitoff +* copset copfwd coprev COP: conic perspective +* coeset coefwd coerev COE: conic equal area +* codset codfwd codrev COD: conic equidistant +* cooset coofwd coorev COO: conic orthomorphic +* bonset bonfwd bonrev BON: Bonne +* pcoset pcofwd pcorev PCO: polyconic +* tscset tscfwd tscrev TSC: tangential spherical cube +* cscset cscfwd cscrev CSC: COBE quadrilateralized spherical cube +* qscset qscfwd qscrev QSC: quadrilateralized spherical cube +* +* +* Driver routines; prjset(), prjfwd() & prjrev() +* ---------------------------------------------- +* A set of driver routines are available for use as a generic interface to +* the specific projection routines. The interfaces to prjfwd() and prjrev() +* are the same as those of the forward and reverse transformation routines +* for the specific projections (see below). +* +* The interface to prjset() differs slightly from that of the initialization +* routines for the specific projections and unlike them it must be invoked +* explicitly to use prjfwd() and prjrev(). +* +* Given: +* pcode[4] const char +* WCS projection code. +* +* Given and/or returned: +* prj prjprm* Projection parameters (see below). +* +* Function return value: +* int Error status +* 0: Success. +* +* +* Initialization routine; *set() +* ------------------------------ +* Initializes members of a prjprm data structure which hold intermediate +* values. Note that this routine need not be called directly; it will be +* invoked by prjfwd() and prjrev() if the "flag" structure member is +* anything other than a predefined magic value. +* +* Given and/or returned: +* prj prjprm* Projection parameters (see below). +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid projection parameters. +* +* Forward transformation; *fwd() +* ----------------------------- +* Compute (x,y) coordinates in the plane of projection from native spherical +* coordinates (phi,theta). +* +* Given: +* phi, const double +* theta Longitude and latitude of the projected point in +* native spherical coordinates, in degrees. +* +* Given and returned: +* prj prjprm* Projection parameters (see below). +* +* Returned: +* x,y double* Projected coordinates. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid projection parameters. +* 2: Invalid value of (phi,theta). +* +* Reverse transformation; *rev() +* ----------------------------- +* Compute native spherical coordinates (phi,theta) from (x,y) coordinates in +* the plane of projection. +* +* Given: +* x,y const double +* Projected coordinates. +* +* Given and returned: +* prj prjprm* Projection parameters (see below). +* +* Returned: +* phi, double* Longitude and latitude of the projected point in +* theta native spherical coordinates, in degrees. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid projection parameters. +* 2: Invalid value of (x,y). +* 1: Invalid projection parameters. +* +* Projection parameters +* --------------------- +* The prjprm struct consists of the following: +* +* int flag +* This flag must be set to zero whenever any of p[10] or r0 are set +* or changed. This signals the initialization routine to recompute +* intermediaries. flag may also be set to -1 to disable strict bounds +* checking for the AZP, SZP, TAN, SIN, ZPN, and COP projections. +* +* double r0 +* r0; The radius of the generating sphere for the projection, a linear +* scaling parameter. If this is zero, it will be reset to the default +* value of 180/pi (the value for FITS WCS). +* +* double p[10] +* The first 10 elements contain projection parameters which correspond +* to the PROJPn keywords in FITS, so p[0] is PROJP0, and p[9] is +* PROJP9. Many projections use p[1] (PROJP1) and some also use p[2] +* (PROJP2). ZPN is the only projection which uses any of the others. +* +* The remaining members of the prjprm struct are maintained by the +* initialization routines and should not be modified. This is done for the +* sake of efficiency and to allow an arbitrary number of contexts to be +* maintained simultaneously. +* +* char code[4] +* Three-letter projection code. +* +* double phi0, theta0 +* Native longitude and latitude of the reference point, in degrees. +* +* double w[10] +* int n +* Intermediate values derived from the projection parameters. +* +* int (*prjfwd)() +* int (*prjrev)() +* Pointers to the forward and reverse projection routines. +* +* Usage of the p[] array as it applies to each projection is described in +* the prologue to each trio of projection routines. +* +* Argument checking +* ----------------- +* Forward routines: +* +* The values of phi and theta (the native longitude and latitude) +* normally lie in the range [-180,180] for phi, and [-90,90] for theta. +* However, all forward projections will accept any value of phi and will +* not normalize it. +* +* The forward projection routines do not explicitly check that theta lies +* within the range [-90,90]. They do check for any value of theta which +* produces an invalid argument to the projection equations (e.g. leading +* to division by zero). The forward routines for AZP, SZP, TAN, SIN, +* ZPN, and COP also return error 2 if (phi,theta) corresponds to the +* overlapped (far) side of the projection but also return the +* corresponding value of (x,y). This strict bounds checking may be +* relaxed by setting prj->flag to -1 (rather than 0) when these +* projections are initialized. +* +* Reverse routines: +* +* Error checking on the projected coordinates (x,y) is limited to that +* required to ascertain whether a solution exists. Where a solution does +* exist no check is made that the value of phi and theta obtained lie +* within the ranges [-180,180] for phi, and [-90,90] for theta. +* +* Accuracy +* -------- +* Closure to a precision of at least 1E-10 degree of longitude and latitude +* has been verified for typical projection parameters on the 1 degree grid +* of native longitude and latitude (to within 5 degrees of any latitude +* where the projection may diverge). +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: proj.c,v 1.1.1.1 2016/03/30 20:00:02 joye Exp $ +*===========================================================================*/ + +#include <stdlib.h> +#include <string.h> +#include <math.h> +#include "wcslib.h" + +int npcode = 26; +char pcodes[26][4] = + {"AZP", "SZP", "TAN", "STG", "SIN", "ARC", "ZPN", "ZEA", "AIR", "CYP", + "CEA", "CAR", "MER", "COP", "COE", "COD", "COO", "SFL", "PAR", "MOL", + "AIT", "BON", "PCO", "TSC", "CSC", "QSC"}; + +const int AZP = 101; +const int SZP = 102; +const int TAN = 103; +const int STG = 104; +const int SIN = 105; +const int ARC = 106; +const int ZPN = 107; +const int ZEA = 108; +const int AIR = 109; +const int CYP = 201; +const int CEA = 202; +const int CAR = 203; +const int MER = 204; +const int SFL = 301; +const int PAR = 302; +const int MOL = 303; +const int AIT = 401; +const int COP = 501; +const int COE = 502; +const int COD = 503; +const int COO = 504; +const int BON = 601; +const int PCO = 602; +const int TSC = 701; +const int CSC = 702; +const int QSC = 703; + +/* Map error number to error message for each function. */ +const char *prjset_errmsg[] = { + 0, + "Invalid projection parameters"}; + +const char *prjfwd_errmsg[] = { + 0, + "Invalid projection parameters", + "Invalid value of (phi,theta)"}; + +const char *prjrev_errmsg[] = { + 0, + "Invalid projection parameters", + "Invalid value of (x,y)"}; + +#define copysgn(X, Y) ((Y) < 0.0 ? -fabs(X) : fabs(X)) +#define copysgni(X, Y) ((Y) < 0 ? -abs(X) : abs(X)) + +/*==========================================================================*/ + +int prjset(pcode, prj) + +const char pcode[4]; +struct prjprm *prj; + +{ + /* Set pointers to the forward and reverse projection routines. */ + if (strcmp(pcode, "AZP") == 0) { + azpset(prj); + } else if (strcmp(pcode, "SZP") == 0) { + szpset(prj); + } else if (strcmp(pcode, "TAN") == 0) { + tanset(prj); + } else if (strcmp(pcode, "STG") == 0) { + stgset(prj); + } else if (strcmp(pcode, "SIN") == 0) { + sinset(prj); + } else if (strcmp(pcode, "ARC") == 0) { + arcset(prj); + } else if (strcmp(pcode, "ZPN") == 0) { + zpnset(prj); + } else if (strcmp(pcode, "ZEA") == 0) { + zeaset(prj); + } else if (strcmp(pcode, "AIR") == 0) { + airset(prj); + } else if (strcmp(pcode, "CYP") == 0) { + cypset(prj); + } else if (strcmp(pcode, "CEA") == 0) { + ceaset(prj); + } else if (strcmp(pcode, "CAR") == 0) { + carset(prj); + } else if (strcmp(pcode, "MER") == 0) { + merset(prj); + } else if (strcmp(pcode, "SFL") == 0) { + sflset(prj); + } else if (strcmp(pcode, "PAR") == 0) { + parset(prj); + } else if (strcmp(pcode, "MOL") == 0) { + molset(prj); + } else if (strcmp(pcode, "AIT") == 0) { + aitset(prj); + } else if (strcmp(pcode, "COP") == 0) { + copset(prj); + } else if (strcmp(pcode, "COE") == 0) { + coeset(prj); + } else if (strcmp(pcode, "COD") == 0) { + codset(prj); + } else if (strcmp(pcode, "COO") == 0) { + cooset(prj); + } else if (strcmp(pcode, "BON") == 0) { + bonset(prj); + } else if (strcmp(pcode, "PCO") == 0) { + pcoset(prj); + } else if (strcmp(pcode, "TSC") == 0) { + tscset(prj); + } else if (strcmp(pcode, "CSC") == 0) { + cscset(prj); + } else if (strcmp(pcode, "QSC") == 0) { + qscset(prj); + } else { + /* Unrecognized projection code. */ + return 1; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int prjfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + return prj->prjfwd(phi, theta, prj, x, y); +} + +/*--------------------------------------------------------------------------*/ + +int prjrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + return prj->prjrev(x, y, prj, phi, theta); +} + +/*============================================================================ +* AZP: zenithal/azimuthal perspective projection. +* +* Given: +* prj->p[1] Distance parameter, mu in units of r0. +* prj->p[2] Tilt angle, gamma in degrees. +* +* Given and/or returned: +* prj->flag AZP, or -AZP if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "AZP" +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] r0*(mu+1) +* prj->w[1] tan(gamma) +* prj->w[2] sec(gamma) +* prj->w[3] cos(gamma) +* prj->w[4] sin(gamma) +* prj->w[5] asin(-1/mu) for |mu| >= 1, -90 otherwise +* prj->w[6] mu*cos(gamma) +* prj->w[7] 1 if |mu*cos(gamma)| < 1, 0 otherwise +* prj->prjfwd Pointer to azpfwd(). +* prj->prjrev Pointer to azprev(). +*===========================================================================*/ + +int azpset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "AZP"); + prj->flag = copysgni (AZP, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = prj->r0*(prj->p[1] + 1.0); + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[3] = cosdeg (prj->p[2]); + if (prj->w[3] == 0.0) { + return 1; + } + + prj->w[2] = 1.0/prj->w[3]; + prj->w[4] = sindeg (prj->p[2]); + prj->w[1] = prj->w[4] / prj->w[3]; + + if (fabs(prj->p[1]) > 1.0) { + prj->w[5] = asindeg (-1.0/prj->p[1]); + } else { + prj->w[5] = -90.0; + } + + prj->w[6] = prj->p[1] * prj->w[3]; + prj->w[7] = (fabs(prj->w[6]) < 1.0) ? 1.0 : 0.0; + + prj->prjfwd = azpfwd; + prj->prjrev = azprev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int azpfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, b, cphi, cthe, r, s, t; + + if (abs(prj->flag) != AZP) { + if (azpset(prj)) return 1; + } + + cphi = cosdeg (phi); + cthe = cosdeg (theta); + + s = prj->w[1]*cphi; + t = (prj->p[1] + sindeg (theta)) + cthe*s; + if (t == 0.0) { + return 2; + } + + r = prj->w[0]*cthe/t; + *x = r*sindeg (phi); + *y = -r*cphi*prj->w[2]; + + /* Bounds checking. */ + if (prj->flag > 0) { + /* Overlap. */ + if (theta < prj->w[5]) { + return 2; + } + + /* Divergence. */ + if (prj->w[7] > 0.0) { + t = prj->p[1] / sqrt(1.0 + s*s); + + if (fabs(t) <= 1.0) { + s = atandeg (-s); + t = asindeg (t); + a = s - t; + b = s + t + 180.0; + + if (a > 90.0) a -= 360.0; + if (b > 90.0) b -= 360.0; + + if (theta < ((a > b) ? a : b)) { + return 2; + } + } + } + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int azprev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, b, r, s, t, ycosg; + const double tol = 1.0e-13; + + if (abs(prj->flag) != AZP) { + if (azpset(prj)) return 1; + } + + ycosg = y*prj->w[3]; + + r = sqrt(x*x + ycosg*ycosg); + if (r == 0.0) { + *phi = 0.0; + *theta = 90.0; + } else { + *phi = atan2deg (x, -ycosg); + + s = r / (prj->w[0] + y*prj->w[4]); + t = s*prj->p[1]/sqrt(s*s + 1.0); + + s = atan2deg (1.0, s); + + if (fabs(t) > 1.0) { + t = copysgn (90.0,t); + if (fabs(t) > 1.0+tol) { + return 2; + } + } else { + t = asindeg (t); + } + + a = s - t; + b = s + t + 180.0; + + if (a > 90.0) a -= 360.0; + if (b > 90.0) b -= 360.0; + + *theta = (a > b) ? a : b; + } + + return 0; +} + +/*============================================================================ +* SZP: slant zenithal perspective projection. +* +* Given: +* prj->p[1] Distance of the point of projection from the centre of the +* generating sphere, mu in units of r0. +* prj->p[2] Native longitude, phi_c, and ... +* prj->p[3] Native latitude, theta_c, on the planewards side of the +* intersection of the line through the point of projection +* and the centre of the generating sphere, phi_c in degrees. +* +* Given and/or returned: +* prj->flag SZP, or -SZP if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "SZP" +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] 1/r0 +* prj->w[1] xp = -mu*cos(theta_c)*sin(phi_c) +* prj->w[2] yp = mu*cos(theta_c)*cos(phi_c) +* prj->w[3] zp = mu*sin(theta_c) + 1 +* prj->w[4] r0*xp +* prj->w[5] r0*yp +* prj->w[6] r0*zp +* prj->w[7] (zp - 1)^2 +* prj->w[8] asin(1-zp) if |1 - zp| < 1, -90 otherwise +* prj->prjfwd Pointer to szpfwd(). +* prj->prjrev Pointer to szprev(). +*===========================================================================*/ + +int szpset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "SZP"); + prj->flag = copysgni (SZP, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = 1.0/prj->r0; + + prj->w[3] = prj->p[1] * sindeg (prj->p[3]) + 1.0; + if (prj->w[3] == 0.0) { + return 1; + } + + prj->w[1] = -prj->p[1] * cosdeg (prj->p[3]) * sindeg (prj->p[2]); + prj->w[2] = prj->p[1] * cosdeg (prj->p[3]) * cosdeg (prj->p[2]); + prj->w[4] = prj->r0 * prj->w[1]; + prj->w[5] = prj->r0 * prj->w[2]; + prj->w[6] = prj->r0 * prj->w[3]; + prj->w[7] = (prj->w[3] - 1.0) * prj->w[3] - 1.0; + + if (fabs(prj->w[3] - 1.0) < 1.0) { + prj->w[8] = asindeg (1.0 - prj->w[3]); + } else { + prj->w[8] = -90.0; + } + + prj->prjfwd = szpfwd; + prj->prjrev = szprev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int szpfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, b, cphi, cthe, s, sphi, t; + + if (abs(prj->flag) != SZP) { + if (szpset(prj)) return 1; + } + + cphi = cosdeg (phi); + sphi = sindeg (phi); + cthe = cosdeg (theta); + s = 1.0 - sindeg (theta); + + t = prj->w[3] - s; + if (t == 0.0) { + return 2; + } + + *x = (prj->w[6]*cthe*sphi - prj->w[4]*s)/t; + *y = -(prj->w[6]*cthe*cphi + prj->w[5]*s)/t; + + /* Bounds checking. */ + if (prj->flag > 0) { + /* Divergence. */ + if (theta < prj->w[8]) { + return 2; + } + + /* Overlap. */ + if (fabs(prj->p[1]) > 1.0) { + s = prj->w[1]*sphi - prj->w[2]*cphi; + t = 1.0/sqrt(prj->w[7] + s*s); + + if (fabs(t) <= 1.0) { + s = atan2deg (s, prj->w[3] - 1.0); + t = asindeg (t); + a = s - t; + b = s + t + 180.0; + + if (a > 90.0) a -= 360.0; + if (b > 90.0) b -= 360.0; + + if (theta < ((a > b) ? a : b)) { + return 2; + } + } + } + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int szprev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, b, c, d, r2, sth1, sth2, sthe, sxy, t, x1, xp, y1, yp, z; + const double tol = 1.0e-13; + + if (abs(prj->flag) != SZP) { + if (szpset(prj)) return 1; + } + + xp = x*prj->w[0]; + yp = y*prj->w[0]; + r2 = xp*xp + yp*yp; + + x1 = (xp - prj->w[1])/prj->w[3]; + y1 = (yp - prj->w[2])/prj->w[3]; + sxy = xp*x1 + yp*y1; + + if (r2 < 1.0e-10) { + /* Use small angle formula. */ + z = r2/2.0; + *theta = 90.0 - R2D*sqrt(r2/(1.0 + sxy)); + + } else { + t = x1*x1 + y1*y1; + a = t + 1.0; + b = sxy - t; + c = r2 - sxy - sxy + t - 1.0; + d = b*b - a*c; + + /* Check for a solution. */ + if (d < 0.0) { + return 2; + } + d = sqrt(d); + + /* Choose solution closest to pole. */ + sth1 = (-b + d)/a; + sth2 = (-b - d)/a; + sthe = (sth1 > sth2) ? sth1 : sth2; + if (sthe > 1.0) { + if (sthe-1.0 < tol) { + sthe = 1.0; + } else { + sthe = (sth1 < sth2) ? sth1 : sth2; + } + } + + if (sthe < -1.0) { + if (sthe+1.0 > -tol) { + sthe = -1.0; + } + } + + if (sthe > 1.0 || sthe < -1.0) { + return 2; + } + + *theta = asindeg (sthe); + + z = 1.0 - sthe; + } + + *phi = atan2deg (xp - x1*z, -(yp - y1*z)); + + return 0; +} + +/*============================================================================ +* TAN: gnomonic projection. +* +* Given and/or returned: +* prj->flag TAN, or -TAN if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "TAN" +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->prjfwd Pointer to tanfwd(). +* prj->prjrev Pointer to tanrev(). +*===========================================================================*/ + +int tanset(prj) + +struct prjprm *prj; + +{ + int k; + + strcpy(prj->code, "TAN"); + prj->flag = copysgni (TAN, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->prjfwd = tanfwd; + prj->prjrev = tanrev; + + for (k = (MAXPV-1); k >= 0 && prj->ppv[k] == 0.0 && prj->ppv[k+MAXPV] == 0.0; k--); + if (k < 0) + k = 0; + prj->npv = k; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int tanfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double r, s; + double xp[2]; + + if (abs(prj->flag) != TAN) { + if(tanset(prj)) return 1; + } + + s = sindeg (theta); + if (s <= 0.0) { + return 2; + } + + r = prj->r0*cosdeg (theta)/s; + xp[0] = r*sindeg (phi); + xp[1] = -r*cosdeg (phi); + *x = prj->inv_x? poly_func(prj->inv_x, xp) : xp[0]; + *y = prj->inv_y? poly_func(prj->inv_y, xp) : xp[1]; + + if (prj->flag > 0 && s < 0.0) { + return 2; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int tanrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double r; + double xp; + double yp; + + if (abs(prj->flag) != TAN) { + if (tanset(prj)) return 1; + } + + if (prj->npv) { + raw_to_pv(prj, x,y, &xp, &yp); + } else { + xp = x; + yp = y; + } + + r = sqrt(xp*xp + yp*yp); + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (xp, -yp); + } + + *theta = atan2deg (prj->r0, r); + + return 0; +} + +/*============================================================================ +* STG: stereographic projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "STG" +* prj->flag STG +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] 2*r0 +* prj->w[1] 1/(2*r0) +* prj->prjfwd Pointer to stgfwd(). +* prj->prjrev Pointer to stgrev(). +*===========================================================================*/ + +int stgset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "STG"); + prj->flag = STG; + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 360.0/PI; + prj->w[1] = PI/360.0; + } else { + prj->w[0] = 2.0*prj->r0; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = stgfwd; + prj->prjrev = stgrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int stgfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double r, s; + + if (prj->flag != STG) { + if (stgset(prj)) return 1; + } + + s = 1.0 + sindeg (theta); + if (s == 0.0) { + return 2; + } + + r = prj->w[0]*cosdeg (theta)/s; + *x = r*sindeg (phi); + *y = -r*cosdeg (phi); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int stgrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double r; + + if (prj->flag != STG) { + if (stgset(prj)) return 1; + } + + r = sqrt(x*x + y*y); + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (x, -y); + } + *theta = 90.0 - 2.0*atandeg (r*prj->w[1]); + + return 0; +} + +/*============================================================================ +* SIN: orthographic/synthesis projection. +* +* Given: +* prj->p[1:2] Obliqueness parameters, xi and eta. +* +* Given and/or returned: +* prj->flag SIN, or -SIN if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "SIN" +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] 1/r0 +* prj->w[1] xi**2 + eta**2 +* prj->w[2] xi**2 + eta**2 + 1 +* prj->w[3] xi**2 + eta**2 - 1 +* prj->prjfwd Pointer to sinfwd(). +* prj->prjrev Pointer to sinrev(). +*===========================================================================*/ + +int sinset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "SIN"); + prj->flag = copysgni (SIN, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = 1.0/prj->r0; + prj->w[1] = prj->p[1]*prj->p[1] + prj->p[2]*prj->p[2]; + prj->w[2] = prj->w[1] + 1.0; + prj->w[3] = prj->w[1] - 1.0; + + prj->prjfwd = sinfwd; + prj->prjrev = sinrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int sinfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double cphi, cthe, sphi, t, z; + + if (abs(prj->flag) != SIN) { + if (sinset(prj)) return 1; + } + + t = (90.0 - fabs(theta))*D2R; + if (t < 1.0e-5) { + if (theta > 0.0) { + z = t*t/2.0; + } else { + z = 2.0 - t*t/2.0; + } + cthe = t; + } else { + z = 1.0 - sindeg (theta); + cthe = cosdeg (theta); + } + + cphi = cosdeg (phi); + sphi = sindeg (phi); + *x = prj->r0*(cthe*sphi + prj->p[1]*z); + *y = -prj->r0*(cthe*cphi - prj->p[2]*z); + + /* Validate this solution. */ + if (prj->flag > 0) { + if (prj->w[1] == 0.0) { + /* Orthographic projection. */ + if (theta < 0.0) { + return 2; + } + } else { + /* "Synthesis" projection. */ + t = -atandeg (prj->p[1]*sphi - prj->p[2]*cphi); + if (theta < t) { + return 2; + } + } + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int sinrev (x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + const double tol = 1.0e-13; + double a, b, c, d, r2, sth1, sth2, sthe, sxy, x0, x1, xp, y0, y1, yp, z; + + if (abs(prj->flag) != SIN) { + if (sinset(prj)) return 1; + } + + /* Compute intermediaries. */ + x0 = x*prj->w[0]; + y0 = y*prj->w[0]; + r2 = x0*x0 + y0*y0; + + if (prj->w[1] == 0.0) { + /* Orthographic projection. */ + if (r2 != 0.0) { + *phi = atan2deg (x0, -y0); + } else { + *phi = 0.0; + } + + if (r2 < 0.5) { + *theta = acosdeg (sqrt(r2)); + } else if (r2 <= 1.0) { + *theta = asindeg (sqrt(1.0 - r2)); + } else { + return 2; + } + + } else { + /* "Synthesis" projection. */ + x1 = prj->p[1]; + y1 = prj->p[2]; + sxy = x0*x1 + y0*y1; + + if (r2 < 1.0e-10) { + /* Use small angle formula. */ + z = r2/2.0; + *theta = 90.0 - R2D*sqrt(r2/(1.0 + sxy)); + + } else { + a = prj->w[2]; + b = sxy - prj->w[1]; + c = r2 - sxy - sxy + prj->w[3]; + d = b*b - a*c; + + /* Check for a solution. */ + if (d < 0.0) { + return 2; + } + d = sqrt(d); + + /* Choose solution closest to pole. */ + sth1 = (-b + d)/a; + sth2 = (-b - d)/a; + sthe = (sth1 > sth2) ? sth1 : sth2; + if (sthe > 1.0) { + if (sthe-1.0 < tol) { + sthe = 1.0; + } else { + sthe = (sth1 < sth2) ? sth1 : sth2; + } + } + + if (sthe < -1.0) { + if (sthe+1.0 > -tol) { + sthe = -1.0; + } + } + + if (sthe > 1.0 || sthe < -1.0) { + return 2; + } + + *theta = asindeg (sthe); + z = 1.0 - sthe; + } + + xp = -y0 + prj->p[2]*z; + yp = x0 - prj->p[1]*z; + if (xp == 0.0 && yp == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (yp,xp); + } + } + + return 0; +} + +/*============================================================================ +* ARC: zenithal/azimuthal equidistant projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "ARC" +* prj->flag ARC +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->prjfwd Pointer to arcfwd(). +* prj->prjrev Pointer to arcrev(). +*===========================================================================*/ + +int arcset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "ARC"); + prj->flag = ARC; + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = arcfwd; + prj->prjrev = arcrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int arcfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double r; + + if (prj->flag != ARC) { + if (arcset(prj)) return 1; + } + + r = prj->w[0]*(90.0 - theta); + *x = r*sindeg (phi); + *y = -r*cosdeg (phi); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int arcrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double r; + + if (prj->flag != ARC) { + if (arcset(prj)) return 1; + } + + r = sqrt(x*x + y*y); + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (x, -y); + } + *theta = 90.0 - r*prj->w[1]; + + return 0; +} + +/*============================================================================ +* ZPN: zenithal/azimuthal polynomial projection. +* +* Given: +* prj->p[0:9] Polynomial coefficients. +* +* Given and/or returned: +* prj->flag ZPN, or -ZPN if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "ZPN" +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->n Degree of the polynomial, N. +* prj->w[0] Co-latitude of the first point of inflection (N > 2). +* prj->w[1] Radius of the first point of inflection (N > 2). +* prj->prjfwd Pointer to zpnfwd(). +* prj->prjrev Pointer to zpnrev(). +*===========================================================================*/ + +int zpnset(prj) + +struct prjprm *prj; + +{ + int i, j, k; + double d, d1, d2, r, zd, zd1, zd2; + const double tol = 1.0e-13; + + strcpy(prj->code, "ZPN"); + prj->flag = copysgni (ZPN, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + /* Find the highest non-zero coefficient. */ + for (k = 9; k >= 0 && prj->p[k] == 0.0; k--){ + i = 0; } + /* if (k < 0) return 1; */ + + /* if (k < 0 switch to ARC projection */ + if (k < 0) { + return (arcset (prj)); + } + + prj->n = k; + + /* No negative derivative -> no point of inflection. */ + zd = PI; + + /* Processing subroutines */ + prj->prjfwd = zpnfwd; + prj->prjrev = zpnrev; + + if (k >= 3) { + /* Find the point of inflection closest to the pole. */ + zd1 = 0.0; + d1 = prj->p[1]; + if (d1 <= 0.0) { + return 1; + } + + /* Find the point where the derivative first goes negative. */ + for (i = 0; i < 180; i++) { + zd2 = i*D2R; + d2 = 0.0; + for (j = k; j > 0; j--) { + d2 = d2*zd2 + j*prj->p[j]; + } + + if (d2 <= 0.0) break; + zd1 = zd2; + d1 = d2; + } + + if (i == 180) { + /* No negative derivative -> no point of inflection. */ + zd = PI; + } else { + /* Find where the derivative is zero. */ + for (i = 1; i <= 10; i++) { + zd = zd1 - d1*(zd2-zd1)/(d2-d1); + + d = 0.0; + for (j = k; j > 0; j--) { + d = d*zd + j*prj->p[j]; + } + + if (fabs(d) < tol) break; + + if (d < 0.0) { + zd2 = zd; + d2 = d; + } else { + zd1 = zd; + d1 = d; + } + } + } + + r = 0.0; + for (j = k; j >= 0; j--) { + r = r*zd + prj->p[j]; + } + prj->w[0] = zd; + prj->w[1] = r; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int zpnfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + int j; + double r, s; + + if (abs(prj->flag) != ZPN) { + if (zpnset(prj)) return 1; + } + + s = (90.0 - theta)*D2R; + + r = 0.0; + for (j = 9; j >= 0; j--) { + r = r*s + prj->p[j]; + } + r = prj->r0*r; + + *x = r*sindeg (phi); + *y = -r*cosdeg (phi); + + if (prj->flag > 0 && s > prj->w[0]) { + return 2; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int zpnrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + int i, j, k; + double a, b, c, d, lambda, r, r1, r2, rt, zd, zd1, zd2; + const double tol = 1.0e-13; + + if (abs(prj->flag) != ZPN) { + if (zpnset(prj)) return 1; + } + + k = prj->n; + + r = sqrt(x*x + y*y)/prj->r0; + + if (k < 1) { + /* Constant - no solution. */ + return 1; + } else if (k == 1) { + /* Linear. */ + zd = (r - prj->p[0])/prj->p[1]; + } else if (k == 2) { + /* Quadratic. */ + a = prj->p[2]; + b = prj->p[1]; + c = prj->p[0] - r; + + d = b*b - 4.0*a*c; + if (d < 0.0) { + return 2; + } + d = sqrt(d); + + /* Choose solution closest to pole. */ + zd1 = (-b + d)/(2.0*a); + zd2 = (-b - d)/(2.0*a); + zd = (zd1<zd2) ? zd1 : zd2; + if (zd < -tol) zd = (zd1>zd2) ? zd1 : zd2; + if (zd < 0.0) { + if (zd < -tol) { + return 2; + } + zd = 0.0; + } else if (zd > PI) { + if (zd > PI+tol) { + return 2; + } + zd = PI; + } + } else { + /* Higher order - solve iteratively. */ + zd1 = 0.0; + r1 = prj->p[0]; + zd2 = prj->w[0]; + r2 = prj->w[1]; + + if (r < r1) { + if (r < r1-tol) { + return 2; + } + zd = zd1; + } else if (r > r2) { + if (r > r2+tol) { + return 2; + } + zd = zd2; + } else { + /* Disect the interval. */ + for (j = 0; j < 100; j++) { + lambda = (r2 - r)/(r2 - r1); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + + zd = zd2 - lambda*(zd2 - zd1); + + rt = 0.0; + for (i = k; i >= 0; i--) { + rt = (rt * zd) + prj->p[i]; + } + + if (rt < r) { + if (r-rt < tol) break; + r1 = rt; + zd1 = zd; + } else { + if (rt-r < tol) break; + r2 = rt; + zd2 = zd; + } + + if (fabs(zd2-zd1) < tol) break; + } + } + } + + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (x, -y); + } + *theta = 90.0 - zd*R2D; + + return 0; +} + +/*============================================================================ +* ZEA: zenithal/azimuthal equal area projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "ZEA" +* prj->flag ZEA +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] 2*r0 +* prj->w[1] 1/(2*r0) +* prj->prjfwd Pointer to zeafwd(). +* prj->prjrev Pointer to zearev(). +*===========================================================================*/ + +int zeaset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "ZEA"); + prj->flag = ZEA; + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 360.0/PI; + prj->w[1] = PI/360.0; + } else { + prj->w[0] = 2.0*prj->r0; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = zeafwd; + prj->prjrev = zearev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int zeafwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double r; + + if (prj->flag != ZEA) { + if (zeaset(prj)) return 1; + } + + r = prj->w[0]*sindeg ((90.0 - theta)/2.0); + *x = r*sindeg (phi); + *y = -r*cosdeg (phi); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int zearev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double r, s; + const double tol = 1.0e-12; + + if (prj->flag != ZEA) { + if (zeaset(prj)) return 1; + } + + r = sqrt(x*x + y*y); + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (x, -y); + } + + s = r*prj->w[1]; + if (fabs(s) > 1.0) { + if (fabs(r - prj->w[0]) < tol) { + *theta = -90.0; + } else { + return 2; + } + } else { + *theta = 90.0 - 2.0*asindeg (s); + } + + return 0; +} + +/*============================================================================ +* AIR: Airy's projection. +* +* Given: +* prj->p[1] Latitude theta_b within which the error is minimized, in +* degrees. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "AIR" +* prj->flag AIR +* prj->phi0 0.0 +* prj->theta0 90.0 +* prj->w[0] 2*r0 +* prj->w[1] ln(cos(xi_b))/tan(xi_b)**2, where xi_b = (90-theta_b)/2 +* prj->w[2] 1/2 - prj->w[1] +* prj->w[3] 2*r0*prj->w[2] +* prj->w[4] tol, cutoff for using small angle approximation, in +* radians. +* prj->w[5] prj->w[2]*tol +* prj->w[6] (180/pi)/prj->w[2] +* prj->prjfwd Pointer to airfwd(). +* prj->prjrev Pointer to airrev(). +*===========================================================================*/ + +int airset(prj) + +struct prjprm *prj; + +{ + const double tol = 1.0e-4; + double cxi; + + strcpy(prj->code, "AIR"); + prj->flag = AIR; + prj->phi0 = 0.0; + prj->theta0 = 90.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = 2.0*prj->r0; + if (prj->p[1] == 90.0) { + prj->w[1] = -0.5; + prj->w[2] = 1.0; + } else if (prj->p[1] > -90.0) { + cxi = cosdeg ((90.0 - prj->p[1])/2.0); + prj->w[1] = log(cxi)*(cxi*cxi)/(1.0-cxi*cxi); + prj->w[2] = 0.5 - prj->w[1]; + } else { + return 1; + } + + prj->w[3] = prj->w[0] * prj->w[2]; + prj->w[4] = tol; + prj->w[5] = prj->w[2]*tol; + prj->w[6] = R2D/prj->w[2]; + + prj->prjfwd = airfwd; + prj->prjrev = airrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int airfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double cxi, r, txi, xi; + + if (prj->flag != AIR) { + if (airset(prj)) return 1; + } + + if (theta == 90.0) { + r = 0.0; + } else if (theta > -90.0) { + xi = D2R*(90.0 - theta)/2.0; + if (xi < prj->w[4]) { + r = xi*prj->w[3]; + } else { + cxi = cosdeg ((90.0 - theta)/2.0); + txi = sqrt(1.0-cxi*cxi)/cxi; + r = -prj->w[0]*(log(cxi)/txi + prj->w[1]*txi); + } + } else { + return 2; + } + + *x = r*sindeg (phi); + *y = -r*cosdeg (phi); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int airrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + int j; + double cxi, lambda, r, r1, r2, rt, txi, x1, x2, xi; + const double tol = 1.0e-12; + + if (prj->flag != AIR) { + if (airset(prj)) return 1; + } + + r = sqrt(x*x + y*y)/prj->w[0]; + + if (r == 0.0) { + xi = 0.0; + } else if (r < prj->w[5]) { + xi = r*prj->w[6]; + } else { + /* Find a solution interval. */ + x1 = 1.0; + r1 = 0.0; + for (j = 0; j < 30; j++) { + x2 = x1/2.0; + txi = sqrt(1.0-x2*x2)/x2; + r2 = -(log(x2)/txi + prj->w[1]*txi); + + if (r2 >= r) break; + x1 = x2; + r1 = r2; + } + if (j == 30) return 2; + + for (j = 0; j < 100; j++) { + /* Weighted division of the interval. */ + lambda = (r2-r)/(r2-r1); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + cxi = x2 - lambda*(x2-x1); + + txi = sqrt(1.0-cxi*cxi)/cxi; + rt = -(log(cxi)/txi + prj->w[1]*txi); + + if (rt < r) { + if (r-rt < tol) break; + r1 = rt; + x1 = cxi; + } else { + if (rt-r < tol) break; + r2 = rt; + x2 = cxi; + } + } + if (j == 100) return 2; + + xi = acosdeg (cxi); + } + + if (r == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (x, -y); + } + *theta = 90.0 - 2.0*xi; + + return 0; +} + +/*============================================================================ +* CYP: cylindrical perspective projection. +* +* Given: +* prj->p[1] Distance of point of projection from the centre of the +* generating sphere, mu, in units of r0. +* prj->p[2] Radius of the cylinder of projection, lambda, in units of +* r0. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "CYP" +* prj->flag CYP +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*lambda*(pi/180) +* prj->w[1] (180/pi)/(r0*lambda) +* prj->w[2] r0*(mu + lambda) +* prj->w[3] 1/(r0*(mu + lambda)) +* prj->prjfwd Pointer to cypfwd(). +* prj->prjrev Pointer to cyprev(). +*===========================================================================*/ + +int cypset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "CYP"); + prj->flag = CYP; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + + prj->w[0] = prj->p[2]; + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + + prj->w[2] = R2D*(prj->p[1] + prj->p[2]); + if (prj->w[2] == 0.0) { + return 1; + } + + prj->w[3] = 1.0/prj->w[2]; + } else { + prj->w[0] = prj->r0*prj->p[2]*D2R; + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + + prj->w[2] = prj->r0*(prj->p[1] + prj->p[2]); + if (prj->w[2] == 0.0) { + return 1; + } + + prj->w[3] = 1.0/prj->w[2]; + } + + prj->prjfwd = cypfwd; + prj->prjrev = cyprev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int cypfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double s; + + if (prj->flag != CYP) { + if (cypset(prj)) return 1; + } + + s = prj->p[1] + cosdeg (theta); + if (s == 0.0) { + return 2; + } + + *x = prj->w[0]*phi; + *y = prj->w[2]*sindeg (theta)/s; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int cyprev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double eta; + + if (prj->flag != CYP) { + if (cypset(prj)) return 1; + } + + *phi = x*prj->w[1]; + eta = y*prj->w[3]; + *theta = atan2deg (eta,1.0) + asindeg (eta*prj->p[1]/sqrt(eta*eta+1.0)); + + return 0; +} + +/*============================================================================ +* CEA: cylindrical equal area projection. +* +* Given: +* prj->p[1] Square of the cosine of the latitude at which the +* projection is conformal, lambda. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "CEA" +* prj->flag CEA +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->w[2] r0/lambda +* prj->w[3] lambda/r0 +* prj->prjfwd Pointer to ceafwd(). +* prj->prjrev Pointer to cearev(). +*===========================================================================*/ + +int ceaset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "CEA"); + prj->flag = CEA; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + if (prj->p[1] <= 0.0 || prj->p[1] > 1.0) { + return 1; + } + prj->w[2] = prj->r0/prj->p[1]; + prj->w[3] = prj->p[1]/prj->r0; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = R2D/prj->r0; + if (prj->p[1] <= 0.0 || prj->p[1] > 1.0) { + return 1; + } + prj->w[2] = prj->r0/prj->p[1]; + prj->w[3] = prj->p[1]/prj->r0; + } + + prj->prjfwd = ceafwd; + prj->prjrev = cearev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int ceafwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + if (prj->flag != CEA) { + if (ceaset(prj)) return 1; + } + + *x = prj->w[0]*phi; + *y = prj->w[2]*sindeg (theta); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int cearev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double s; + const double tol = 1.0e-13; + + if (prj->flag != CEA) { + if (ceaset(prj)) return 1; + } + + s = y*prj->w[3]; + if (fabs(s) > 1.0) { + if (fabs(s) > 1.0+tol) { + return 2; + } + s = copysgn (1.0,s); + } + + *phi = x*prj->w[1]; + *theta = asindeg (s); + + return 0; +} + +/*============================================================================ +* CAR: Cartesian projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "CAR" +* prj->flag CAR +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->prjfwd Pointer to carfwd(). +* prj->prjrev Pointer to carrev(). +*===========================================================================*/ + +int carset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "CAR"); + prj->flag = CAR; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = carfwd; + prj->prjrev = carrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int carfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + if (prj->flag != CAR) { + if (carset(prj)) return 1; + } + + *x = prj->w[0]*phi; + *y = prj->w[0]*theta; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int carrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + if (prj->flag != CAR) { + if (carset(prj)) return 1; + } + + *phi = prj->w[1]*x; + *theta = prj->w[1]*y; + + return 0; +} + +/*============================================================================ +* MER: Mercator's projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "MER" +* prj->flag MER +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->prjfwd Pointer to merfwd(). +* prj->prjrev Pointer to merrev(). +*===========================================================================*/ + +int merset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "MER"); + prj->flag = MER; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = merfwd; + prj->prjrev = merrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int merfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + if (prj->flag != MER) { + if (merset(prj)) return 1; + } + + if (theta <= -90.0 || theta >= 90.0) { + return 2; + } + + *x = prj->w[0]*phi; + *y = prj->r0*log(tandeg ((90.0+theta)/2.0)); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int merrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + if (prj->flag != MER) { + if (merset(prj)) return 1; + } + + *phi = x*prj->w[1]; + *theta = 2.0*atandeg (exp(y/prj->r0)) - 90.0; + + return 0; +} + +/*============================================================================ +* SFL: Sanson-Flamsteed ("global sinusoid") projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "SFL" +* prj->flag SFL +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->prjfwd Pointer to sflfwd(). +* prj->prjrev Pointer to sflrev(). +*===========================================================================*/ + +int sflset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "SFL"); + prj->flag = SFL; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = sflfwd; + prj->prjrev = sflrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int sflfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + if (prj->flag != SFL) { + if (sflset(prj)) return 1; + } + + *x = prj->w[0]*phi*cosdeg (theta); + *y = prj->w[0]*theta; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int sflrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double w; + + if (prj->flag != SFL) { + if (sflset(prj)) return 1; + } + + w = cos(y/prj->r0); + if (w == 0.0) { + *phi = 0.0; + } else { + *phi = x*prj->w[1]/cos(y/prj->r0); + } + *theta = y*prj->w[1]; + + return 0; +} + +/*============================================================================ +* PAR: parabolic projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "PAR" +* prj->flag PAR +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] (180/pi)/r0 +* prj->w[2] pi*r0 +* prj->w[3] 1/(pi*r0) +* prj->prjfwd Pointer to parfwd(). +* prj->prjrev Pointer to parrev(). +*===========================================================================*/ + +int parset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "PAR"); + prj->flag = PAR; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + prj->w[2] = 180.0; + prj->w[3] = 1.0/prj->w[2]; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + prj->w[2] = PI*prj->r0; + prj->w[3] = 1.0/prj->w[2]; + } + + prj->prjfwd = parfwd; + prj->prjrev = parrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int parfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double s; + + if (prj->flag != PAR) { + if (parset(prj)) return 1; + } + + s = sindeg (theta/3.0); + *x = prj->w[0]*phi*(1.0 - 4.0*s*s); + *y = prj->w[2]*s; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int parrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double s, t; + + if (prj->flag != PAR) { + if (parset(prj)) return 1; + } + + s = y*prj->w[3]; + if (s > 1.0 || s < -1.0) { + return 2; + } + + t = 1.0 - 4.0*s*s; + if (t == 0.0) { + if (x == 0.0) { + *phi = 0.0; + } else { + return 2; + } + } else { + *phi = prj->w[1]*x/t; + } + + *theta = 3.0*asindeg (s); + + return 0; +} + +/*============================================================================ +* MOL: Mollweide's projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "MOL" +* prj->flag MOL +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] sqrt(2)*r0 +* prj->w[1] sqrt(2)*r0/90 +* prj->w[2] 1/(sqrt(2)*r0) +* prj->w[3] 90/r0 +* prj->prjfwd Pointer to molfwd(). +* prj->prjrev Pointer to molrev(). +*===========================================================================*/ + +int molset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "MOL"); + prj->flag = MOL; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = SQRT2*prj->r0; + prj->w[1] = prj->w[0]/90.0; + prj->w[2] = 1.0/prj->w[0]; + prj->w[3] = 90.0/prj->r0; + prj->w[4] = 2.0/PI; + + prj->prjfwd = molfwd; + prj->prjrev = molrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int molfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + int j; + double gamma, resid, u, v, v0, v1; + const double tol = 1.0e-13; + + if (prj->flag != MOL) { + if (molset(prj)) return 1; + } + + if (fabs(theta) == 90.0) { + *x = 0.0; + *y = copysgn (prj->w[0],theta); + } else if (theta == 0.0) { + *x = prj->w[1]*phi; + *y = 0.0; + } else { + u = PI*sindeg (theta); + v0 = -PI; + v1 = PI; + v = u; + for (j = 0; j < 100; j++) { + resid = (v - u) + sin(v); + if (resid < 0.0) { + if (resid > -tol) break; + v0 = v; + } else { + if (resid < tol) break; + v1 = v; + } + v = (v0 + v1)/2.0; + } + + gamma = v/2.0; + *x = prj->w[1]*phi*cos(gamma); + *y = prj->w[0]*sin(gamma); + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int molrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double s, y0, z; + const double tol = 1.0e-12; + + if (prj->flag != MOL) { + if (molset(prj)) return 1; + } + + y0 = y/prj->r0; + s = 2.0 - y0*y0; + if (s <= tol) { + if (s < -tol) { + return 2; + } + s = 0.0; + + if (fabs(x) > tol) { + return 2; + } + *phi = 0.0; + } else { + s = sqrt(s); + *phi = prj->w[3]*x/s; + } + + z = y*prj->w[2]; + if (fabs(z) > 1.0) { + if (fabs(z) > 1.0+tol) { + return 2; + } + z = copysgn (1.0,z) + y0*s/PI; + } else { + z = asin(z)*prj->w[4] + y0*s/PI; + } + + if (fabs(z) > 1.0) { + if (fabs(z) > 1.0+tol) { + return 2; + } + z = copysgn (1.0,z); + } + + *theta = asindeg (z); + + return 0; +} + +/*============================================================================ +* AIT: Hammer-Aitoff projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "AIT" +* prj->flag AIT +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] 2*r0**2 +* prj->w[1] 1/(2*r0)**2 +* prj->w[2] 1/(4*r0)**2 +* prj->w[3] 1/(2*r0) +* prj->prjfwd Pointer to aitfwd(). +* prj->prjrev Pointer to aitrev(). +*===========================================================================*/ + +int aitset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "AIT"); + prj->flag = AIT; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = 2.0*prj->r0*prj->r0; + prj->w[1] = 1.0/(2.0*prj->w[0]); + prj->w[2] = prj->w[1]/4.0; + prj->w[3] = 1.0/(2.0*prj->r0); + + prj->prjfwd = aitfwd; + prj->prjrev = aitrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int aitfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double cthe, w; + + if (prj->flag != AIT) { + if (aitset(prj)) return 1; + } + + cthe = cosdeg (theta); + w = sqrt(prj->w[0]/(1.0 + cthe*cosdeg (phi/2.0))); + *x = 2.0*w*cthe*sindeg (phi/2.0); + *y = w*sindeg (theta); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int aitrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double s, u, xp, yp, z; + const double tol = 1.0e-13; + + if (prj->flag != AIT) { + if (aitset(prj)) return 1; + } + + u = 1.0 - x*x*prj->w[2] - y*y*prj->w[1]; + if (u < 0.0) { + if (u < -tol) { + return 2; + } + + u = 0.0; + } + + z = sqrt(u); + s = z*y/prj->r0; + if (fabs(s) > 1.0) { + if (fabs(s) > 1.0+tol) { + return 2; + } + s = copysgn (1.0,s); + } + + xp = 2.0*z*z - 1.0; + yp = z*x*prj->w[3]; + if (xp == 0.0 && yp == 0.0) { + *phi = 0.0; + } else { + *phi = 2.0*atan2deg (yp, xp); + } + *theta = asindeg (s); + + return 0; +} + +/*============================================================================ +* COP: conic perspective projection. +* +* Given: +* prj->p[1] sigma = (theta2+theta1)/2 +* prj->p[2] delta = (theta2-theta1)/2, where theta1 and theta2 are the +* latitudes of the standard parallels, in degrees. +* +* Given and/or returned: +* prj->flag COP, or -COP if prj->flag is given < 0. +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "COP" +* prj->phi0 0.0 +* prj->theta0 sigma +* prj->w[0] C = sin(sigma) +* prj->w[1] 1/C +* prj->w[2] Y0 = r0*cos(delta)*cot(sigma) +* prj->w[3] r0*cos(delta) +* prj->w[4] 1/(r0*cos(delta) +* prj->w[5] cot(sigma) +* prj->prjfwd Pointer to copfwd(). +* prj->prjrev Pointer to coprev(). +*===========================================================================*/ + +int copset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "COP"); + prj->flag = copysgni (COP, prj->flag); + prj->phi0 = 0.0; + prj->theta0 = prj->p[1]; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + prj->w[0] = sindeg (prj->p[1]); + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + + prj->w[3] = prj->r0*cosdeg (prj->p[2]); + if (prj->w[3] == 0.0) { + return 1; + } + + prj->w[4] = 1.0/prj->w[3]; + prj->w[5] = 1.0/tandeg (prj->p[1]); + + prj->w[2] = prj->w[3]*prj->w[5]; + + prj->prjfwd = copfwd; + prj->prjrev = coprev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int copfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, r, s, t; + + if (abs(prj->flag) != COP) { + if (copset(prj)) return 1; + } + + t = theta - prj->p[1]; + s = cosdeg (t); + if (s == 0.0) { + return 2; + } + + a = prj->w[0]*phi; + r = prj->w[2] - prj->w[3]*sindeg (t)/s; + + *x = r*sindeg (a); + *y = prj->w[2] - r*cosdeg (a); + + if (prj->flag > 0 && r*prj->w[0] < 0.0) { + return 2; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int coprev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, dy, r; + + if (abs(prj->flag) != COP) { + if (copset(prj)) return 1; + } + + dy = prj->w[2] - y; + r = sqrt(x*x + dy*dy); + if (prj->p[1] < 0.0) r = -r; + + if (r == 0.0) { + a = 0.0; + } else { + a = atan2deg (x/r, dy/r); + } + + *phi = a*prj->w[1]; + *theta = prj->p[1] + atandeg (prj->w[5] - r*prj->w[4]); + + return 0; +} + +/*============================================================================ +* COE: conic equal area projection. +* +* Given: +* prj->p[1] sigma = (theta2+theta1)/2 +* prj->p[2] delta = (theta2-theta1)/2, where theta1 and theta2 are the +* latitudes of the standard parallels, in degrees. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "COE" +* prj->flag COE +* prj->phi0 0.0 +* prj->theta0 sigma +* prj->w[0] C = (sin(theta1) + sin(theta2))/2 +* prj->w[1] 1/C +* prj->w[2] Y0 = chi*sqrt(psi - 2C*sindeg (sigma)) +* prj->w[3] chi = r0/C +* prj->w[4] psi = 1 + sin(theta1)*sin(theta2) +* prj->w[5] 2C +* prj->w[6] (1 + sin(theta1)*sin(theta2))*(r0/C)**2 +* prj->w[7] C/(2*r0**2) +* prj->w[8] chi*sqrt(psi + 2C) +* prj->prjfwd Pointer to coefwd(). +* prj->prjrev Pointer to coerev(). +*===========================================================================*/ + +int coeset(prj) + +struct prjprm *prj; + +{ + double theta1, theta2; + + strcpy(prj->code, "COE"); + prj->flag = COE; + prj->phi0 = 0.0; + prj->theta0 = prj->p[1]; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + theta1 = prj->p[1] - prj->p[2]; + theta2 = prj->p[1] + prj->p[2]; + + prj->w[0] = (sindeg (theta1) + sindeg (theta2))/2.0; + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + + prj->w[3] = prj->r0/prj->w[0]; + prj->w[4] = 1.0 + sindeg (theta1)*sindeg (theta2); + prj->w[5] = 2.0*prj->w[0]; + prj->w[6] = prj->w[3]*prj->w[3]*prj->w[4]; + prj->w[7] = 1.0/(2.0*prj->r0*prj->w[3]); + prj->w[8] = prj->w[3]*sqrt(prj->w[4] + prj->w[5]); + + prj->w[2] = prj->w[3]*sqrt(prj->w[4] - prj->w[5]*sindeg (prj->p[1])); + + prj->prjfwd = coefwd; + prj->prjrev = coerev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int coefwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, r; + + if (prj->flag != COE) { + if (coeset(prj)) return 1; + } + + a = phi*prj->w[0]; + if (theta == -90.0) { + r = prj->w[8]; + } else { + r = prj->w[3]*sqrt(prj->w[4] - prj->w[5]*sindeg (theta)); + } + + *x = r*sindeg (a); + *y = prj->w[2] - r*cosdeg (a); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int coerev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, dy, r, w; + const double tol = 1.0e-12; + + if (prj->flag != COE) { + if (coeset(prj)) return 1; + } + + dy = prj->w[2] - y; + r = sqrt(x*x + dy*dy); + if (prj->p[1] < 0.0) r = -r; + + if (r == 0.0) { + a = 0.0; + } else { + a = atan2deg (x/r, dy/r); + } + + *phi = a*prj->w[1]; + if (fabs(r - prj->w[8]) < tol) { + *theta = -90.0; + } else { + w = (prj->w[6] - r*r)*prj->w[7]; + if (fabs(w) > 1.0) { + if (fabs(w-1.0) < tol) { + *theta = 90.0; + } else if (fabs(w+1.0) < tol) { + *theta = -90.0; + } else { + return 2; + } + } else { + *theta = asindeg (w); + } + } + + return 0; +} + +/*============================================================================ +* COD: conic equidistant projection. +* +* Given: +* prj->p[1] sigma = (theta2+theta1)/2 +* prj->p[2] delta = (theta2-theta1)/2, where theta1 and theta2 are the +* latitudes of the standard parallels, in degrees. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "COD" +* prj->flag COD +* prj->phi0 0.0 +* prj->theta0 sigma +* prj->w[0] C = r0*sin(sigma)*sin(delta)/delta +* prj->w[1] 1/C +* prj->w[2] Y0 = delta*cot(delta)*cot(sigma) +* prj->w[3] Y0 + sigma +* prj->prjfwd Pointer to codfwd(). +* prj->prjrev Pointer to codrev(). +*===========================================================================*/ + +int codset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "COD"); + prj->flag = COD; + prj->phi0 = 0.0; + prj->theta0 = prj->p[1]; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + if (prj->p[2] == 0.0) { + prj->w[0] = prj->r0*sindeg (prj->p[1])*D2R; + } else { + prj->w[0] = prj->r0*sindeg (prj->p[1])*sindeg (prj->p[2])/prj->p[2]; + } + + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + prj->w[2] = prj->r0*cosdeg (prj->p[2])*cosdeg (prj->p[1])/prj->w[0]; + prj->w[3] = prj->w[2] + prj->p[1]; + + prj->prjfwd = codfwd; + prj->prjrev = codrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int codfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, r; + + if (prj->flag != COD) { + if (codset(prj)) return 1; + } + + a = prj->w[0]*phi; + r = prj->w[3] - theta; + + *x = r*sindeg (a); + *y = prj->w[2] - r*cosdeg (a); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int codrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, dy, r; + + if (prj->flag != COD) { + if (codset(prj)) return 1; + } + + dy = prj->w[2] - y; + r = sqrt(x*x + dy*dy); + if (prj->p[1] < 0.0) r = -r; + + if (r == 0.0) { + a = 0.0; + } else { + a = atan2deg (x/r, dy/r); + } + + *phi = a*prj->w[1]; + *theta = prj->w[3] - r; + + return 0; +} + +/*============================================================================ +* COO: conic orthomorphic projection. +* +* Given: +* prj->p[1] sigma = (theta2+theta1)/2 +* prj->p[2] delta = (theta2-theta1)/2, where theta1 and theta2 are the +* latitudes of the standard parallels, in degrees. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "COO" +* prj->flag COO +* prj->phi0 0.0 +* prj->theta0 sigma +* prj->w[0] C = ln(cos(theta2)/cos(theta1))/ln(tan(tau2)/tan(tau1)) +* where tau1 = (90 - theta1)/2 +* tau2 = (90 - theta2)/2 +* prj->w[1] 1/C +* prj->w[2] Y0 = psi*tan((90-sigma)/2)**C +* prj->w[3] psi = (r0*cos(theta1)/C)/tan(tau1)**C +* prj->w[4] 1/psi +* prj->prjfwd Pointer to coofwd(). +* prj->prjrev Pointer to coorev(). +*===========================================================================*/ + +int cooset(prj) + +struct prjprm *prj; + +{ + double cos1, cos2, tan1, tan2, theta1, theta2; + + strcpy(prj->code, "COO"); + prj->flag = COO; + prj->phi0 = 0.0; + prj->theta0 = prj->p[1]; + + if (prj->r0 == 0.0) prj->r0 = R2D; + + theta1 = prj->p[1] - prj->p[2]; + theta2 = prj->p[1] + prj->p[2]; + + tan1 = tandeg ((90.0 - theta1)/2.0); + cos1 = cosdeg (theta1); + + if (theta1 == theta2) { + prj->w[0] = sindeg (theta1); + } else { + tan2 = tandeg ((90.0 - theta2)/2.0); + cos2 = cosdeg (theta2); + prj->w[0] = log(cos2/cos1)/log(tan2/tan1); + } + if (prj->w[0] == 0.0) { + return 1; + } + + prj->w[1] = 1.0/prj->w[0]; + + prj->w[3] = prj->r0*(cos1/prj->w[0])/pow(tan1,prj->w[0]); + if (prj->w[3] == 0.0) { + return 1; + } + prj->w[2] = prj->w[3]*pow(tandeg ((90.0 - prj->p[1])/2.0),prj->w[0]); + prj->w[4] = 1.0/prj->w[3]; + + prj->prjfwd = coofwd; + prj->prjrev = coorev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int coofwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, r; + + if (prj->flag != COO) { + if (cooset(prj)) return 1; + } + + a = prj->w[0]*phi; + if (theta == -90.0) { + if (prj->w[0] < 0.0) { + r = 0.0; + } else { + return 2; + } + } else { + r = prj->w[3]*pow(tandeg ((90.0 - theta)/2.0),prj->w[0]); + } + + *x = r*sindeg (a); + *y = prj->w[2] - r*cosdeg (a); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int coorev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, dy, r; + + if (prj->flag != COO) { + if (cooset(prj)) return 1; + } + + dy = prj->w[2] - y; + r = sqrt(x*x + dy*dy); + if (prj->p[1] < 0.0) r = -r; + + if (r == 0.0) { + a = 0.0; + } else { + a = atan2deg (x/r, dy/r); + } + + *phi = a*prj->w[1]; + if (r == 0.0) { + if (prj->w[0] < 0.0) { + *theta = -90.0; + } else { + return 2; + } + } else { + *theta = 90.0 - 2.0*atandeg (pow(r*prj->w[4],prj->w[1])); + } + + return 0; +} + +/*============================================================================ +* BON: Bonne's projection. +* +* Given: +* prj->p[1] Bonne conformal latitude, theta1, in degrees. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "BON" +* prj->flag BON +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[1] r0*pi/180 +* prj->w[2] Y0 = r0*(cot(theta1) + theta1*pi/180) +* prj->prjfwd Pointer to bonfwd(). +* prj->prjrev Pointer to bonrev(). +*===========================================================================*/ + +int bonset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "BON"); + prj->flag = BON; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[1] = 1.0; + prj->w[2] = prj->r0*cosdeg (prj->p[1])/sindeg (prj->p[1]) + prj->p[1]; + } else { + prj->w[1] = prj->r0*D2R; + prj->w[2] = prj->r0*(cosdeg (prj->p[1])/sindeg (prj->p[1]) + prj->p[1]*D2R); + } + + prj->prjfwd = bonfwd; + prj->prjrev = bonrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int bonfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, r; + + if (prj->p[1] == 0.0) { + /* Sanson-Flamsteed. */ + return sflfwd(phi, theta, prj, x, y); + } + + if (prj->flag != BON) { + if (bonset(prj)) return 1; + } + + r = prj->w[2] - theta*prj->w[1]; + a = prj->r0*phi*cosdeg (theta)/r; + + *x = r*sindeg (a); + *y = prj->w[2] - r*cosdeg (a); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int bonrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double a, cthe, dy, r; + + if (prj->p[1] == 0.0) { + /* Sanson-Flamsteed. */ + return sflrev(x, y, prj, phi, theta); + } + + if (prj->flag != BON) { + if (bonset(prj)) return 1; + } + + dy = prj->w[2] - y; + r = sqrt(x*x + dy*dy); + if (prj->p[1] < 0.0) r = -r; + + if (r == 0.0) { + a = 0.0; + } else { + a = atan2deg (x/r, dy/r); + } + + *theta = (prj->w[2] - r)/prj->w[1]; + cthe = cosdeg (*theta); + if (cthe == 0.0) { + *phi = 0.0; + } else { + *phi = a*(r/prj->r0)/cthe; + } + + return 0; +} + +/*============================================================================ +* PCO: polyconic projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "PCO" +* prj->flag PCO +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/180) +* prj->w[1] 1/r0 +* prj->w[2] 2*r0 +* prj->prjfwd Pointer to pcofwd(). +* prj->prjrev Pointer to pcorev(). +*===========================================================================*/ + +int pcoset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "PCO"); + prj->flag = PCO; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 1.0; + prj->w[1] = 1.0; + prj->w[2] = 360.0/PI; + } else { + prj->w[0] = prj->r0*D2R; + prj->w[1] = 1.0/prj->w[0]; + prj->w[2] = 2.0*prj->r0; + } + + prj->prjfwd = pcofwd; + prj->prjrev = pcorev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int pcofwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + double a, cthe, cotthe, sthe; + + if (prj->flag != PCO) { + if (pcoset(prj)) return 1; + } + + cthe = cosdeg (theta); + sthe = sindeg (theta); + a = phi*sthe; + + if (sthe == 0.0) { + *x = prj->w[0]*phi; + *y = 0.0; + } else { + cotthe = cthe/sthe; + *x = prj->r0*cotthe*sindeg (a); + *y = prj->r0*(cotthe*(1.0 - cosdeg (a)) + theta*D2R); + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int pcorev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + int j; + double f, fneg, fpos, lambda, tanthe, theneg, thepos, w, xp, xx, ymthe, yp; + const double tol = 1.0e-12; + + if (prj->flag != PCO) { + if (pcoset(prj)) return 1; + } + + w = fabs(y*prj->w[1]); + if (w < tol) { + *phi = x*prj->w[1]; + *theta = 0.0; + } else if (fabs(w-90.0) < tol) { + *phi = 0.0; + *theta = copysgni (90.0,y); + } else { + /* Iterative solution using weighted division of the interval. */ + if (y > 0.0) { + thepos = 90.0; + } else { + thepos = -90.0; + } + theneg = 0.0; + + xx = x*x; + ymthe = y - prj->w[0]*thepos; + fpos = xx + ymthe*ymthe; + fneg = -999.0; + + for (j = 0; j < 64; j++) { + if (fneg < -100.0) { + /* Equal division of the interval. */ + *theta = (thepos+theneg)/2.0; + } else { + /* Weighted division of the interval. */ + lambda = fpos/(fpos-fneg); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + *theta = thepos - lambda*(thepos-theneg); + } + + /* Compute the residue. */ + ymthe = y - prj->w[0]*(*theta); + tanthe = tandeg (*theta); + f = xx + ymthe*(ymthe - prj->w[2]/tanthe); + + /* Check for convergence. */ + if (fabs(f) < tol) break; + if (fabs(thepos-theneg) < tol) break; + + /* Redefine the interval. */ + if (f > 0.0) { + thepos = *theta; + fpos = f; + } else { + theneg = *theta; + fneg = f; + } + } + + xp = prj->r0 - ymthe*tanthe; + yp = x*tanthe; + if (xp == 0.0 && yp == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (yp, xp)/sindeg (*theta); + } + } + + return 0; +} + +/*============================================================================ +* TSC: tangential spherical cube projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "TSC" +* prj->flag TSC +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/4) +* prj->w[1] (4/pi)/r0 +* prj->prjfwd Pointer to tscfwd(). +* prj->prjrev Pointer to tscrev(). +*===========================================================================*/ + +int tscset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "TSC"); + prj->flag = TSC; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 45.0; + prj->w[1] = 1.0/45.0; + } else { + prj->w[0] = prj->r0*PI/4.0; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = tscfwd; + prj->prjrev = tscrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int tscfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + int face; + double cthe, l, m, n, rho; + double x0 = 0.0; + double y0 = 0.0; + double xf = 0.0; + double yf = 0.0; + const double tol = 1.0e-12; + + if (prj->flag != TSC) { + if (tscset(prj)) return 1; + } + + cthe = cosdeg (theta); + l = cthe*cosdeg (phi); + m = cthe*sindeg (phi); + n = sindeg (theta); + + face = 0; + rho = n; + if (l > rho) { + face = 1; + rho = l; + } + if (m > rho) { + face = 2; + rho = m; + } + if (-l > rho) { + face = 3; + rho = -l; + } + if (-m > rho) { + face = 4; + rho = -m; + } + if (-n > rho) { + face = 5; + rho = -n; + } + + if (face == 0) { + xf = m/rho; + yf = -l/rho; + x0 = 0.0; + y0 = 2.0; + } else if (face == 1) { + xf = m/rho; + yf = n/rho; + x0 = 0.0; + y0 = 0.0; + } else if (face == 2) { + xf = -l/rho; + yf = n/rho; + x0 = 2.0; + y0 = 0.0; + } else if (face == 3) { + xf = -m/rho; + yf = n/rho; + x0 = 4.0; + y0 = 0.0; + } else if (face == 4) { + xf = l/rho; + yf = n/rho; + x0 = 6.0; + y0 = 0.0; + } else if (face == 5) { + xf = m/rho; + yf = l/rho; + x0 = 0.0; + y0 = -2.0; + } + + if (fabs(xf) > 1.0) { + if (fabs(xf) > 1.0+tol) { + return 2; + } + xf = copysgn (1.0,xf); + } + if (fabs(yf) > 1.0) { + if (fabs(yf) > 1.0+tol) { + return 2; + } + yf = copysgn (1.0,yf); + } + + *x = prj->w[0]*(xf + x0); + *y = prj->w[0]*(yf + y0); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int tscrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + double l, m, n, xf, yf; + + if (prj->flag != TSC) { + if (tscset(prj)) return 1; + } + + xf = x*prj->w[1]; + yf = y*prj->w[1]; + + /* Check bounds. */ + if (fabs(xf) <= 1.0) { + if (fabs(yf) > 3.0) return 2; + } else { + if (fabs(xf) > 7.0) return 2; + if (fabs(yf) > 1.0) return 2; + } + + /* Map negative faces to the other side. */ + if (xf < -1.0) xf += 8.0; + + /* Determine the face. */ + if (xf > 5.0) { + /* face = 4 */ + xf = xf - 6.0; + m = -1.0/sqrt(1.0 + xf*xf + yf*yf); + l = -m*xf; + n = -m*yf; + } else if (xf > 3.0) { + /* face = 3 */ + xf = xf - 4.0; + l = -1.0/sqrt(1.0 + xf*xf + yf*yf); + m = l*xf; + n = -l*yf; + } else if (xf > 1.0) { + /* face = 2 */ + xf = xf - 2.0; + m = 1.0/sqrt(1.0 + xf*xf + yf*yf); + l = -m*xf; + n = m*yf; + } else if (yf > 1.0) { + /* face = 0 */ + yf = yf - 2.0; + n = 1.0/sqrt(1.0 + xf*xf + yf*yf); + l = -n*yf; + m = n*xf; + } else if (yf < -1.0) { + /* face = 5 */ + yf = yf + 2.0; + n = -1.0/sqrt(1.0 + xf*xf + yf*yf); + l = -n*yf; + m = -n*xf; + } else { + /* face = 1 */ + l = 1.0/sqrt(1.0 + xf*xf + yf*yf); + m = l*xf; + n = l*yf; + } + + if (l == 0.0 && m == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (m, l); + } + *theta = asindeg (n); + + return 0; +} + +/*============================================================================ +* CSC: COBE quadrilateralized spherical cube projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "CSC" +* prj->flag CSC +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/4) +* prj->w[1] (4/pi)/r0 +* prj->prjfwd Pointer to cscfwd(). +* prj->prjrev Pointer to cscrev(). +*===========================================================================*/ + +int cscset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "CSC"); + prj->flag = CSC; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 45.0; + prj->w[1] = 1.0/45.0; + } else { + prj->w[0] = prj->r0*PI/4.0; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = cscfwd; + prj->prjrev = cscrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int cscfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + int face; + double cthe, eta, l, m, n, rho, xi; + const float tol = 1.0e-7; + + float a, a2, a2b2, a4, ab, b, b2, b4, ca2, cb2; + float x0 = 0.0; + float y0 = 0.0; + float xf = 0.0; + float yf = 0.0; + const float gstar = 1.37484847732; + const float mm = 0.004869491981; + const float gamma = -0.13161671474; + const float omega1 = -0.159596235474; + const float d0 = 0.0759196200467; + const float d1 = -0.0217762490699; + const float c00 = 0.141189631152; + const float c10 = 0.0809701286525; + const float c01 = -0.281528535557; + const float c11 = 0.15384112876; + const float c20 = -0.178251207466; + const float c02 = 0.106959469314; + + if (prj->flag != CSC) { + if (cscset(prj)) return 1; + } + + cthe = cosdeg (theta); + l = cthe*cosdeg (phi); + m = cthe*sindeg (phi); + n = sindeg (theta); + + face = 0; + rho = n; + if (l > rho) { + face = 1; + rho = l; + } + if (m > rho) { + face = 2; + rho = m; + } + if (-l > rho) { + face = 3; + rho = -l; + } + if (-m > rho) { + face = 4; + rho = -m; + } + if (-n > rho) { + face = 5; + rho = -n; + } + + if (face == 0) { + xi = m; + eta = -l; + x0 = 0.0; + y0 = 2.0; + } else if (face == 1) { + xi = m; + eta = n; + x0 = 0.0; + y0 = 0.0; + } else if (face == 2) { + xi = -l; + eta = n; + x0 = 2.0; + y0 = 0.0; + } else if (face == 3) { + xi = -m; + eta = n; + x0 = 4.0; + y0 = 0.0; + } else if (face == 4) { + xi = l; + eta = n; + x0 = 6.0; + y0 = 0.0; + } else if (face == 5) { + xi = m; + eta = l; + x0 = 0.0; + y0 = -2.0; + } + + a = xi/rho; + b = eta/rho; + + a2 = a*a; + b2 = b*b; + ca2 = 1.0 - a2; + cb2 = 1.0 - b2; + + /* Avoid floating underflows. */ + ab = fabs(a*b); + a4 = (a2 > 1.0e-16) ? a2*a2 : 0.0; + b4 = (b2 > 1.0e-16) ? b2*b2 : 0.0; + a2b2 = (ab > 1.0e-16) ? a2*b2 : 0.0; + + xf = a*(a2 + ca2*(gstar + b2*(gamma*ca2 + mm*a2 + + cb2*(c00 + c10*a2 + c01*b2 + c11*a2b2 + c20*a4 + c02*b4)) + + a2*(omega1 - ca2*(d0 + d1*a2)))); + yf = b*(b2 + cb2*(gstar + a2*(gamma*cb2 + mm*b2 + + ca2*(c00 + c10*b2 + c01*a2 + c11*a2b2 + c20*b4 + c02*a4)) + + b2*(omega1 - cb2*(d0 + d1*b2)))); + + if (fabs(xf) > 1.0) { + if (fabs(xf) > 1.0+tol) { + return 2; + } + xf = copysgn (1.0,xf); + } + if (fabs(yf) > 1.0) { + if (fabs(yf) > 1.0+tol) { + return 2; + } + yf = copysgn (1.0,yf); + } + + *x = prj->w[0]*(x0 + xf); + *y = prj->w[0]*(y0 + yf); + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int cscrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + int face; + double l = 0.0; + double m = 0.0; + double n = 0.0; + + float a, b, xf, xx, yf, yy, z0, z1, z2, z3, z4, z5, z6; + const float p00 = -0.27292696; + const float p10 = -0.07629969; + const float p20 = -0.22797056; + const float p30 = 0.54852384; + const float p40 = -0.62930065; + const float p50 = 0.25795794; + const float p60 = 0.02584375; + const float p01 = -0.02819452; + const float p11 = -0.01471565; + const float p21 = 0.48051509; + const float p31 = -1.74114454; + const float p41 = 1.71547508; + const float p51 = -0.53022337; + const float p02 = 0.27058160; + const float p12 = -0.56800938; + const float p22 = 0.30803317; + const float p32 = 0.98938102; + const float p42 = -0.83180469; + const float p03 = -0.60441560; + const float p13 = 1.50880086; + const float p23 = -0.93678576; + const float p33 = 0.08693841; + const float p04 = 0.93412077; + const float p14 = -1.41601920; + const float p24 = 0.33887446; + const float p05 = -0.63915306; + const float p15 = 0.52032238; + const float p06 = 0.14381585; + + if (prj->flag != CSC) { + if (cscset(prj)) return 1; + } + + xf = x*prj->w[1]; + yf = y*prj->w[1]; + + /* Check bounds. */ + if (fabs(xf) <= 1.0) { + if (fabs(yf) > 3.0) return 2; + } else { + if (fabs(xf) > 7.0) return 2; + if (fabs(yf) > 1.0) return 2; + } + + /* Map negative faces to the other side. */ + if (xf < -1.0) xf += 8.0; + + /* Determine the face. */ + if (xf > 5.0) { + face = 4; + xf = xf - 6.0; + } else if (xf > 3.0) { + face = 3; + xf = xf - 4.0; + } else if (xf > 1.0) { + face = 2; + xf = xf - 2.0; + } else if (yf > 1.0) { + face = 0; + yf = yf - 2.0; + } else if (yf < -1.0) { + face = 5; + yf = yf + 2.0; + } else { + face = 1; + } + + xx = xf*xf; + yy = yf*yf; + + z0 = p00 + xx*(p10 + xx*(p20 + xx*(p30 + xx*(p40 + xx*(p50 + xx*(p60)))))); + z1 = p01 + xx*(p11 + xx*(p21 + xx*(p31 + xx*(p41 + xx*(p51))))); + z2 = p02 + xx*(p12 + xx*(p22 + xx*(p32 + xx*(p42)))); + z3 = p03 + xx*(p13 + xx*(p23 + xx*(p33))); + z4 = p04 + xx*(p14 + xx*(p24)); + z5 = p05 + xx*(p15); + z6 = p06; + + a = z0 + yy*(z1 + yy*(z2 + yy*(z3 + yy*(z4 + yy*(z5 + yy*z6))))); + a = xf + xf*(1.0 - xx)*a; + + z0 = p00 + yy*(p10 + yy*(p20 + yy*(p30 + yy*(p40 + yy*(p50 + yy*(p60)))))); + z1 = p01 + yy*(p11 + yy*(p21 + yy*(p31 + yy*(p41 + yy*(p51))))); + z2 = p02 + yy*(p12 + yy*(p22 + yy*(p32 + yy*(p42)))); + z3 = p03 + yy*(p13 + yy*(p23 + yy*(p33))); + z4 = p04 + yy*(p14 + yy*(p24)); + z5 = p05 + yy*(p15); + z6 = p06; + + b = z0 + xx*(z1 + xx*(z2 + xx*(z3 + xx*(z4 + xx*(z5 + xx*z6))))); + b = yf + yf*(1.0 - yy)*b; + + if (face == 0) { + n = 1.0/sqrt(a*a + b*b + 1.0); + l = -b*n; + m = a*n; + } else if (face == 1) { + l = 1.0/sqrt(a*a + b*b + 1.0); + m = a*l; + n = b*l; + } else if (face == 2) { + m = 1.0/sqrt(a*a + b*b + 1.0); + l = -a*m; + n = b*m; + } else if (face == 3) { + l = -1.0/sqrt(a*a + b*b + 1.0); + m = a*l; + n = -b*l; + } else if (face == 4) { + m = -1.0/sqrt(a*a + b*b + 1.0); + l = -a*m; + n = -b*m; + } else if (face == 5) { + n = -1.0/sqrt(a*a + b*b + 1.0); + l = -b*n; + m = -a*n; + } + + if (l == 0.0 && m == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (m, l); + } + *theta = asindeg (n); + + return 0; +} + +/*============================================================================ +* QSC: quadrilaterilized spherical cube projection. +* +* Given and/or returned: +* prj->r0 r0; reset to 180/pi if 0. +* +* Returned: +* prj->code "QSC" +* prj->flag QSC +* prj->phi0 0.0 +* prj->theta0 0.0 +* prj->w[0] r0*(pi/4) +* prj->w[1] (4/pi)/r0 +* prj->prjfwd Pointer to qscfwd(). +* prj->prjrev Pointer to qscrev(). +*===========================================================================*/ + +int qscset(prj) + +struct prjprm *prj; + +{ + strcpy(prj->code, "QSC"); + prj->flag = QSC; + prj->phi0 = 0.0; + prj->theta0 = 0.0; + + if (prj->r0 == 0.0) { + prj->r0 = R2D; + prj->w[0] = 45.0; + prj->w[1] = 1.0/45.0; + } else { + prj->w[0] = prj->r0*PI/4.0; + prj->w[1] = 1.0/prj->w[0]; + } + + prj->prjfwd = qscfwd; + prj->prjrev = qscrev; + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int qscfwd(phi, theta, prj, x, y) + +const double phi, theta; +struct prjprm *prj; +double *x, *y; + +{ + int face; + double cthe, l, m, n, omega, p, rho, rhu, t, tau; + double xi = 0.0; + double eta = 0.0; + double x0 = 0.0; + double y0 = 0.0; + double xf = 0.0; + double yf = 0.0; + const double tol = 1.0e-12; + + if (prj->flag != QSC) { + if (qscset(prj)) return 1; + } + + if (fabs(theta) == 90.0) { + *x = 0.0; + *y = copysgn (2.0*prj->w[0],theta); + return 0; + } + + cthe = cosdeg (theta); + l = cthe*cosdeg (phi); + m = cthe*sindeg (phi); + n = sindeg (theta); + + face = 0; + rho = n; + if (l > rho) { + face = 1; + rho = l; + } + if (m > rho) { + face = 2; + rho = m; + } + if (-l > rho) { + face = 3; + rho = -l; + } + if (-m > rho) { + face = 4; + rho = -m; + } + if (-n > rho) { + face = 5; + rho = -n; + } + + rhu = 1.0 - rho; + + if (face == 0) { + xi = m; + eta = -l; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = (90.0 - theta)*D2R; + rhu = t*t/2.0; + } + x0 = 0.0; + y0 = 2.0; + } else if (face == 1) { + xi = m; + eta = n; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = theta*D2R; + p = fmod(phi,360.0); + if (p < -180.0) p += 360.0; + if (p > 180.0) p -= 360.0; + p *= D2R; + rhu = (p*p + t*t)/2.0; + } + x0 = 0.0; + y0 = 0.0; + } else if (face == 2) { + xi = -l; + eta = n; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = theta*D2R; + p = fmod(phi,360.0); + if (p < -180.0) p += 360.0; + p = (90.0 - p)*D2R; + rhu = (p*p + t*t)/2.0; + } + x0 = 2.0; + y0 = 0.0; + } else if (face == 3) { + xi = -m; + eta = n; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = theta*D2R; + p = fmod(phi,360.0); + if (p < 0.0) p += 360.0; + p = (180.0 - p)*D2R; + rhu = (p*p + t*t)/2.0; + } + x0 = 4.0; + y0 = 0.0; + } else if (face == 4) { + xi = l; + eta = n; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = theta*D2R; + p = fmod(phi,360.0); + if (p > 180.0) p -= 360.0; + p *= (90.0 + p)*D2R; + rhu = (p*p + t*t)/2.0; + } + x0 = 6; + y0 = 0.0; + } else if (face == 5) { + xi = m; + eta = l; + if (rhu < 1.0e-8) { + /* Small angle formula. */ + t = (90.0 + theta)*D2R; + rhu = t*t/2.0; + } + x0 = 0.0; + y0 = -2; + } + + if (xi == 0.0 && eta == 0.0) { + xf = 0.0; + yf = 0.0; + } else if (-xi >= fabs(eta)) { + omega = eta/xi; + tau = 1.0 + omega*omega; + xf = -sqrt(rhu/(1.0-1.0/sqrt(1.0+tau))); + yf = (xf/15.0)*(atandeg (omega) - asindeg (omega/sqrt(tau+tau))); + } else if (xi >= fabs(eta)) { + omega = eta/xi; + tau = 1.0 + omega*omega; + xf = sqrt(rhu/(1.0-1.0/sqrt(1.0+tau))); + yf = (xf/15.0)*(atandeg (omega) - asindeg (omega/sqrt(tau+tau))); + } else if (-eta > fabs(xi)) { + omega = xi/eta; + tau = 1.0 + omega*omega; + yf = -sqrt(rhu/(1.0-1.0/sqrt(1.0+tau))); + xf = (yf/15.0)*(atandeg (omega) - asindeg (omega/sqrt(tau+tau))); + } else if (eta > fabs(xi)) { + omega = xi/eta; + tau = 1.0 + omega*omega; + yf = sqrt(rhu/(1.0-1.0/sqrt(1.0+tau))); + xf = (yf/15.0)*(atandeg (omega) - asindeg (omega/sqrt(tau+tau))); + } + + if (fabs(xf) > 1.0) { + if (fabs(xf) > 1.0+tol) { + return 2; + } + xf = copysgn (1.0,xf); + } + if (fabs(yf) > 1.0) { + if (fabs(yf) > 1.0+tol) { + return 2; + } + yf = copysgn (1.0,yf); + } + + *x = prj->w[0]*(xf + x0); + *y = prj->w[0]*(yf + y0); + + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int qscrev(x, y, prj, phi, theta) + +const double x, y; +struct prjprm *prj; +double *phi, *theta; + +{ + int direct, face; + double omega, rho, rhu, tau, xf, yf, w; + double l = 0.0; + double m = 0.0; + double n = 0.0; + const double tol = 1.0e-12; + + if (prj->flag != QSC) { + if (qscset(prj)) return 1; + } + + xf = x*prj->w[1]; + yf = y*prj->w[1]; + + /* Check bounds. */ + if (fabs(xf) <= 1.0) { + if (fabs(yf) > 3.0) return 2; + } else { + if (fabs(xf) > 7.0) return 2; + if (fabs(yf) > 1.0) return 2; + } + + /* Map negative faces to the other side. */ + if (xf < -1.0) xf += 8.0; + + /* Determine the face. */ + if (xf > 5.0) { + face = 4; + xf = xf - 6.0; + } else if (xf > 3.0) { + face = 3; + xf = xf - 4.0; + } else if (xf > 1.0) { + face = 2; + xf = xf - 2.0; + } else if (yf > 1.0) { + face = 0; + yf = yf - 2.0; + } else if (yf < -1.0) { + face = 5; + yf = yf + 2.0; + } else { + face = 1; + } + + direct = (fabs(xf) > fabs(yf)); + if (direct) { + if (xf == 0.0) { + omega = 0.0; + tau = 1.0; + rho = 1.0; + rhu = 0.0; + } else { + w = 15.0*yf/xf; + omega = sindeg (w)/(cosdeg (w) - SQRT2INV); + tau = 1.0 + omega*omega; + rhu = xf*xf*(1.0 - 1.0/sqrt(1.0 + tau)); + rho = 1.0 - rhu; + } + } else { + if (yf == 0.0) { + omega = 0.0; + tau = 1.0; + rho = 1.0; + rhu = 0.0; + } else { + w = 15.0*xf/yf; + omega = sindeg (w)/(cosdeg (w) - SQRT2INV); + tau = 1.0 + omega*omega; + rhu = yf*yf*(1.0 - 1.0/sqrt(1.0 + tau)); + rho = 1.0 - rhu; + } + } + + if (rho < -1.0) { + if (rho < -1.0-tol) { + return 2; + } + + rho = -1.0; + rhu = 2.0; + w = 0.0; + } else { + w = sqrt(rhu*(2.0-rhu)/tau); + } + + if (face == 0) { + n = rho; + if (direct) { + m = w; + if (xf < 0.0) m = -m; + l = -m*omega; + } else { + l = w; + if (yf > 0.0) l = -l; + m = -l*omega; + } + } else if (face == 1) { + l = rho; + if (direct) { + m = w; + if (xf < 0.0) m = -m; + n = m*omega; + } else { + n = w; + if (yf < 0.0) n = -n; + m = n*omega; + } + } else if (face == 2) { + m = rho; + if (direct) { + l = w; + if (xf > 0.0) l = -l; + n = -l*omega; + } else { + n = w; + if (yf < 0.0) n = -n; + l = -n*omega; + } + } else if (face == 3) { + l = -rho; + if (direct) { + m = w; + if (xf > 0.0) m = -m; + n = -m*omega; + } else { + n = w; + if (yf < 0.0) n = -n; + m = -n*omega; + } + } else if (face == 4) { + m = -rho; + if (direct) { + l = w; + if (xf < 0.0) l = -l; + n = l*omega; + } else { + n = w; + if (yf < 0.0) n = -n; + l = n*omega; + } + } else if (face == 5) { + n = -rho; + if (direct) { + m = w; + if (xf < 0.0) m = -m; + l = m*omega; + } else { + l = w; + if (yf < 0.0) l = -l; + m = l*omega; + } + } + + if (l == 0.0 && m == 0.0) { + *phi = 0.0; + } else { + *phi = atan2deg (m, l); + } + *theta = asindeg (n); + + return 0; +} + +/* This routine comes from E. Bertin sextractor-2.8.6 */ + +int +raw_to_pv(struct prjprm *prj, double x, double y, double *xo, double *yo) + +{ + int k; + double *a,*b, + r,r3,r5,r7,xy,x2,x3,x4,x5,x6,x7,y2,y3,y4,y5,y6,y7,xp,yp; + + + k=prj->npv; + a = prj->ppv+MAXPV; /* Latitude comes first for compatibility */ + b = prj->ppv; /* Longitude */ + xp = *(a++); + xp += *(a++)*x; + yp = *(b++); + yp += *(b++)*y; + if (!--k) goto poly_end; + xp += *(a++)*y; + yp += *(b++)*x; + if (!--k) goto poly_end; + r = sqrt(x*x + y*y); + xp += *(a++)*r; + yp += *(b++)*r; + if (!--k) goto poly_end; + xp += *(a++)*(x2=x*x); + yp += *(b++)*(y2=y*y); + if (!--k) goto poly_end; + xp += *(a++)*(xy=x*y); + yp += *(b++)*xy; + if (!--k) goto poly_end; + xp += *(a++)*y2; + yp += *(b++)*x2; + if (!--k) goto poly_end; + xp += *(a++)*(x3=x*x2); + yp += *(b++)*(y3=y*y2); + if (!--k) goto poly_end; + xp += *(a++)*x2*y; + yp += *(b++)*y2*x; + if (!--k) goto poly_end; + xp += *(a++)*x*y2; + yp += *(b++)*y*x2; + if (!--k) goto poly_end; + xp += *(a++)*y3; + yp += *(b++)*x3; + if (!--k) goto poly_end; + xp += *(a++)*(r3=r*r*r); + yp += *(b++)*r3; + if (!--k) goto poly_end; + xp += *(a++)*(x4=x2*x2); + yp += *(b++)*(y4=y2*y2); + if (!--k) goto poly_end; + xp += *(a++)*x3*y; + yp += *(b++)*y3*x; + if (!--k) goto poly_end; + xp += *(a++)*x2*y2; + yp += *(b++)*x2*y2; + if (!--k) goto poly_end; + xp += *(a++)*x*y3; + yp += *(b++)*y*x3; + if (!--k) goto poly_end; + xp += *(a++)*y4; + yp += *(b++)*x4; + if (!--k) goto poly_end; + xp += *(a++)*(x5=x4*x); + yp += *(b++)*(y5=y4*y); + if (!--k) goto poly_end; + xp += *(a++)*x4*y; + yp += *(b++)*y4*x; + if (!--k) goto poly_end; + xp += *(a++)*x3*y2; + yp += *(b++)*y3*x2; + if (!--k) goto poly_end; + xp += *(a++)*x2*y3; + yp += *(b++)*y2*x3; + if (!--k) goto poly_end; + xp += *(a++)*x*y4; + yp += *(b++)*y*x4; + if (!--k) goto poly_end; + xp += *(a++)*y5; + yp += *(b++)*x5; + if (!--k) goto poly_end; + xp += *(a++)*(r5=r3*r*r); + yp += *(b++)*r5; + if (!--k) goto poly_end; + xp += *(a++)*(x6=x5*x); + yp += *(b++)*(y6=y5*y); + if (!--k) goto poly_end; + xp += *(a++)*x5*y; + yp += *(b++)*y5*x; + if (!--k) goto poly_end; + xp += *(a++)*x4*y2; + yp += *(b++)*y4*x2; + if (!--k) goto poly_end; + xp += *(a++)*x3*y3; + yp += *(b++)*y3*x3; + if (!--k) goto poly_end; + xp += *(a++)*x2*y4; + yp += *(b++)*y2*x4; + if (!--k) goto poly_end; + xp += *(a++)*x*y5; + yp += *(b++)*y*x5; + if (!--k) goto poly_end; + xp += *(a++)*y6; + yp += *(b++)*x6; + if (!--k) goto poly_end; + xp += *(a++)*(x7=x6*x); + yp += *(b++)*(y7=y6*y); + if (!--k) goto poly_end; + xp += *(a++)*x6*y; + yp += *(b++)*y6*x; + if (!--k) goto poly_end; + xp += *(a++)*x5*y2; + yp += *(b++)*y5*x2; + if (!--k) goto poly_end; + xp += *(a++)*x4*y3; + yp += *(b++)*y4*x3; + if (!--k) goto poly_end; + xp += *(a++)*x3*y4; + yp += *(b++)*y3*x4; + if (!--k) goto poly_end; + xp += *(a++)*x2*y5; + yp += *(b++)*y2*x5; + if (!--k) goto poly_end; + xp += *(a++)*x*y6; + yp += *(b++)*y*x6; + if (!--k) goto poly_end; + xp += *(a++)*y7; + yp += *(b++)*x7; + if (!--k) goto poly_end; + xp += *a*(r7=r5*r*r); + yp += *b*r7; + +poly_end: + + *xo = xp; + *yo = yp; + + return 0; +} + +/* Dec 20 1999 Doug Mink - Change cosd() and sind() to cosdeg() and sindeg() + * Dec 20 1999 Doug Mink - Include wcslib.h, which includes proj.h, wcsmath.h + * Dec 20 1999 Doug Mink - Define copysign only if it is not defined + * Dec 20 1999 Doug Mink - tanfwd() returns error if s<=0.0, not only if s==0.0 + * + * Jun 2 2000 Doug Mink - include stdlib.h to get abs() + * + * Feb 15 2001 Doug Mink - update zearev() for WCSLIB 2.6 + * Sep 19 2001 Doug Mink - Make above changes for WCSLIB 2.7 + * + * Mar 15 2002 Doug Mink - Make above changes for WCSLIB 2.8.2 + * + * Feb 3 2003 Doug Mink - Use locally defined copysgn() and copysgni(), + * not copysign() + * Apr 1 2003 Doug Mink - include string.h for strcpy() and strcmp() + * + * Mar 14 2011 Doug Mink - If no coefficients in ZPN, make ARC + * Mar 14 2011 Doug Mink - Add Emmanuel Bertin's TAN polynomial from Ed Los + */ diff --git a/tksao/wcssubs/slasubs.c b/tksao/wcssubs/slasubs.c new file mode 100644 index 0000000..74ddb88 --- /dev/null +++ b/tksao/wcssubs/slasubs.c @@ -0,0 +1,364 @@ +/* File slasubs.c + *** Starlink subroutines by Patrick Wallace used by wcscon.c subroutines + *** April 13, 1998 + */ + +#include <math.h> +#include <string.h> + +/* slaDcs2c (a, b, v): Spherical coordinates to direction cosines. + * slaDcc2s (v, a, b): Direction cosines to spherical coordinates. + * slaDmxv (dm, va, vb): vector vb = matrix dm * vector va + * slaImxv (rm, va, vb): vector vb = (inverse of matrix rm) * vector va + * slaDranrm (angle): Normalize angle into range 0-2 pi. + * slaDrange (angle): Normalize angle into range +/- pi. + * slaDeuler (order, phi, theta, psi, rmat) + * Form a rotation matrix from the Euler angles - three successive + * rotations about specified Cartesian axes. + */ + +void +slaDcs2c (a, b, v) + +double a; /* Right ascension in radians */ +double b; /* Declination in radians */ +double *v; /* x,y,z unit vector (returned) */ + +/* +** slaDcs2c: Spherical coordinates to direction cosines. +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** P.T.Wallace Starlink 31 October 1993 +*/ +{ + double cosb; + + cosb = cos ( b ); + v[0] = cos ( a ) * cosb; + v[1] = sin ( a ) * cosb; + v[2] = sin ( b ); +} + + +void +slaDcc2s (v, a, b) + +double *v; /* x,y,z vector */ +double *a; /* Right ascension in radians */ +double *b; /* Declination in radians */ + +/* +** slaDcc2s: +** Direction cosines to spherical coordinates. +** +** Returned: +** *a,*b double spherical coordinates in radians +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** If v is null, zero a and b are returned. +** At either pole, zero a is returned. +** +** P.T.Wallace Starlink 31 October 1993 +*/ +{ + double x, y, z, r; + + x = v[0]; + y = v[1]; + z = v[2]; + r = sqrt ( x * x + y * y ); + + *a = ( r != 0.0 ) ? atan2 ( y, x ) : 0.0; + *b = ( z != 0.0 ) ? atan2 ( z, r ) : 0.0; +} + + +void +slaDmxv (dm, va, vb) + +double (*dm)[3]; /* 3x3 Matrix */ +double *va; /* Vector */ +double *vb; /* Result vector (returned) */ + +/* +** slaDmxv: +** Performs the 3-d forward unitary transformation: +** vector vb = matrix dm * vector va +** +** P.T.Wallace Starlink 31 October 1993 +*/ +{ + int i, j; + double w, vw[3]; + + /* Matrix dm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dm[j][i] * va[i]; + } + vw[j] = w; + } + + /* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} + + +void slaDimxv (dm, va, vb) + double (*dm)[3]; + double *va; + double *vb; +/* +** - - - - - - - - - +** s l a D i m x v +** - - - - - - - - - +** +** Performs the 3-d backward unitary transformation: +** +** vector vb = (inverse of matrix dm) * vector va +** +** (double precision) +** +** (n.b. The matrix must be unitary, as this routine assumes that +** the inverse and transpose are identical) +** +** +** Given: +** dm double[3][3] matrix +** va double[3] vector +** +** Returned: +** vb double[3] result vector +** +** P.T.Wallace Starlink 31 October 1993 +*/ +{ + long i, j; + double w, vw[3]; + +/* Inverse of matrix dm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dm[i][j] * va[i]; + } + vw[j] = w; + } + +/* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} + + +/* 2pi */ +#define D2PI 6.2831853071795864769252867665590057683943387987502 + +/* pi */ +#define DPI 3.1415926535897932384626433832795028841971693993751 + +double slaDranrm (angle) + +double angle; /* angle in radians */ + +/* +** slaDranrm: +** Normalize angle into range 0-2 pi. +** The result is angle expressed in the range 0-2 pi (double). +** Defined in slamac.h: D2PI +** +** P.T.Wallace Starlink 30 October 1993 +*/ +{ + double w; + + w = fmod ( angle, D2PI ); + return ( w >= 0.0 ) ? w : w + D2PI; +} + +#ifndef dsign +#define dsign(A,B) ((B)<0.0?-(A):(A)) +#endif + +double +slaDrange (angle) + double angle; +/* +** - - - - - - - - - - +** s l a D r a n g e +** - - - - - - - - - - +** +** Normalize angle into range +/- pi. +** +** (double precision) +** +** Given: +** angle double the angle in radians +** +** The result is angle expressed in the +/- pi (double precision). +** +** Defined in slamac.h: DPI, D2PI +** +** P.T.Wallace Starlink 31 October 1993 +*/ +{ + double w; + + w = fmod ( angle, D2PI ); + return ( fabs ( w ) < DPI ) ? w : w - dsign ( D2PI, angle ); +} + + +void +slaDeuler (order, phi, theta, psi, rmat) + +char *order; /* specifies about which axes the rotations occur */ +double phi; /* 1st rotation (radians) */ +double theta; /* 2nd rotation (radians) */ +double psi; /* 3rd rotation (radians) */ +double (*rmat)[3]; /* 3x3 Rotation matrix (returned) */ + +/* +** slaDeuler: +** Form a rotation matrix from the Euler angles - three successive +** rotations about specified Cartesian axes. +** +** A rotation is positive when the reference frame rotates +** anticlockwise as seen looking towards the origin from the +** positive region of the specified axis. +** +** The characters of order define which axes the three successive +** rotations are about. A typical value is 'zxz', indicating that +** rmat is to become the direction cosine matrix corresponding to +** rotations of the reference frame through phi radians about the +** old z-axis, followed by theta radians about the resulting x-axis, +** then psi radians about the resulting z-axis. +** +** The axis names can be any of the following, in any order or +** combination: x, y, z, uppercase or lowercase, 1, 2, 3. Normal +** axis labelling/numbering conventions apply; the xyz (=123) +** triad is right-handed. Thus, the 'zxz' example given above +** could be written 'zxz' or '313' (or even 'zxz' or '3xz'). Order +** is terminated by length or by the first unrecognised character. +** +** Fewer than three rotations are acceptable, in which case the later +** angle arguments are ignored. Zero rotations produces a unit rmat. +** +** P.T.Wallace Starlink 17 November 1993 +*/ +{ + int j, i, l, n, k; + double result[3][3], rotn[3][3], angle, s, c , w, wm[3][3]; + char axis; + +/* Initialize result matrix */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + result[i][j] = ( i == j ) ? 1.0 : 0.0; + } + } + +/* Establish length of axis string */ + l = strlen ( order ); + +/* Look at each character of axis string until finished */ + for ( n = 0; n < 3; n++ ) { + if ( n <= l ) { + + /* Initialize rotation matrix for the current rotation */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + rotn[i][j] = ( i == j ) ? 1.0 : 0.0; + } + } + + /* Pick up the appropriate Euler angle and take sine & cosine */ + switch ( n ) { + case 0 : + angle = phi; + break; + case 1 : + angle = theta; + break; + case 2 : + angle = psi; + break; + } + s = sin ( angle ); + c = cos ( angle ); + + /* Identify the axis */ + axis = order[n]; + if ( ( axis == 'X' ) || ( axis == 'x' ) || ( axis == '1' ) ) { + + /* Matrix for x-rotation */ + rotn[1][1] = c; + rotn[1][2] = s; + rotn[2][1] = -s; + rotn[2][2] = c; + } + else if ( ( axis == 'Y' ) || ( axis == 'y' ) || ( axis == '2' ) ) { + + /* Matrix for y-rotation */ + rotn[0][0] = c; + rotn[0][2] = -s; + rotn[2][0] = s; + rotn[2][2] = c; + } + else if ( ( axis == 'Z' ) || ( axis == 'z' ) || ( axis == '3' ) ) { + + /* Matrix for z-rotation */ + rotn[0][0] = c; + rotn[0][1] = s; + rotn[1][0] = -s; + rotn[1][1] = c; + } else { + + /* Unrecognized character - fake end of string */ + l = 0; + } + + /* Apply the current rotation (matrix rotn x matrix result) */ + for ( i = 0; i < 3; i++ ) { + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( k = 0; k < 3; k++ ) { + w += rotn[i][k] * result[k][j]; + } + wm[i][j] = w; + } + } + for ( j = 0; j < 3; j++ ) { + for ( i= 0; i < 3; i++ ) { + result[i][j] = wm[i][j]; + } + } + } + } + +/* Copy the result */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + rmat[i][j] = result[i][j]; + } + } +} +/* + * Nov 4 1996 New file + * + * Apr 13 1998 Add list of subroutines to start of file + */ diff --git a/tksao/wcssubs/sph.c b/tksao/wcssubs/sph.c new file mode 100644 index 0000000..4e2dcc0 --- /dev/null +++ b/tksao/wcssubs/sph.c @@ -0,0 +1,234 @@ +/*============================================================================ +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* C routines for the spherical coordinate transformations used by the FITS +* "World Coordinate System" (WCS) convention. +* +* Summary of routines +* ------------------- +* The spherical coordinate transformations are implemented via separate +* functions for the transformation in each direction. +* +* Forward transformation; sphfwd() +* -------------------------------- +* Transform celestial coordinates to the native coordinates of a projection. +* +* Given: +* lng,lat double Celestial longitude and latitude, in degrees. +* eul[5] double Euler angles for the transformation: +* 0: Celestial longitude of the native pole, in +* degrees. +* 1: Celestial colatitude of the native pole, or +* native colatitude of the celestial pole, in +* degrees. +* 2: Native longitude of the celestial pole, in +* degrees. +* 3: cos(eul[1]) +* 4: sin(eul[1]) +* +* Returned: +* phi, double Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Function return value: +* int Error status +* 0: Success. +* +* Reverse transformation; sphrev() +* -------------------------------- +* Transform native coordinates of a projection to celestial coordinates. +* +* Given: +* phi, double Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* eul[5] double Euler angles for the transformation: +* 0: Celestial longitude of the native pole, in +* degrees. +* 1: Celestial colatitude of the native pole, or +* native colatitude of the celestial pole, in +* degrees. +* 2: Native longitude of the celestial pole, in +* degrees. +* 3: cos(eul[1]) +* 4: sin(eul[1]) +* +* Returned: +* lng,lat double Celestial longitude and latitude, in degrees. +* +* Function return value: +* int Error status +* 0: Success. +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: sph.c,v 1.1.1.1 2016/03/30 20:00:02 joye Exp $ +*===========================================================================*/ + +#include <math.h> +#include "wcslib.h" + +#ifndef __STDC__ +#ifndef const +#define const +#endif +#endif + +const double tol = 1.0e-5; + +int sphfwd (lng, lat, eul, phi, theta) + +const double lat, lng, eul[5]; +double *phi, *theta; + +{ + double coslat, coslng, dlng, dphi, sinlat, sinlng, x, y, z; + + coslat = cosdeg (lat); + sinlat = sindeg (lat); + + dlng = lng - eul[0]; + coslng = cosdeg (dlng); + sinlng = sindeg (dlng); + + /* Compute the native longitude. */ + x = sinlat*eul[4] - coslat*eul[3]*coslng; + if (fabs(x) < tol) { + /* Rearrange formula to reduce roundoff errors. */ + x = -cosdeg (lat+eul[1]) + coslat*eul[3]*(1.0 - coslng); + } + y = -coslat*sinlng; + if (x != 0.0 || y != 0.0) { + dphi = atan2deg (y, x); + } else { + /* Change of origin of longitude. */ + dphi = dlng - 180.0; + } + *phi = eul[2] + dphi; + + /* Normalize the native longitude. */ + if (*phi > 180.0) { + *phi -= 360.0; + } else if (*phi < -180.0) { + *phi += 360.0; + } + + /* Compute the native latitude. */ + if (fmod(dlng,180.0) == 0.0) { + *theta = lat + coslng*eul[1]; + if (*theta > 90.0) *theta = 180.0 - *theta; + if (*theta < -90.0) *theta = -180.0 - *theta; + } else { + z = sinlat*eul[3] + coslat*eul[4]*coslng; + /* Use an alternative formula for greater numerical accuracy. */ + if (fabs(z) > 0.99) { + if (z < 0) + *theta = -acosdeg (sqrt(x*x+y*y)); + else + *theta = acosdeg (sqrt(x*x+y*y)); + } else { + *theta = asindeg (z); + } + } + + return 0; +} + +/*-----------------------------------------------------------------------*/ + +int sphrev (phi, theta, eul, lng, lat) + +const double phi, theta, eul[5]; +double *lng, *lat; + +{ + double cosphi, costhe, dlng, dphi, sinphi, sinthe, x, y, z; + + costhe = cosdeg (theta); + sinthe = sindeg (theta); + + dphi = phi - eul[2]; + cosphi = cosdeg (dphi); + sinphi = sindeg (dphi); + + /* Compute the celestial longitude. */ + x = sinthe*eul[4] - costhe*eul[3]*cosphi; + if (fabs(x) < tol) { + /* Rearrange formula to reduce roundoff errors. */ + x = -cosdeg (theta+eul[1]) + costhe*eul[3]*(1.0 - cosphi); + } + y = -costhe*sinphi; + if (x != 0.0 || y != 0.0) { + dlng = atan2deg (y, x); + } else { + /* Change of origin of longitude. */ + dlng = dphi + 180.0; + } + *lng = eul[0] + dlng; + + /* Normalize the celestial longitude. */ + if (eul[0] >= 0.0) { + if (*lng < 0.0) *lng += 360.0; + } else { + if (*lng > 0.0) *lng -= 360.0; + } + + if (*lng > 360.0) { + *lng -= 360.0; + } else if (*lng < -360.0) { + *lng += 360.0; + } + + /* Compute the celestial latitude. */ + if (fmod(dphi,180.0) == 0.0) { + *lat = theta + cosphi*eul[1]; + if (*lat > 90.0) *lat = 180.0 - *lat; + if (*lat < -90.0) *lat = -180.0 - *lat; + } else { + z = sinthe*eul[3] + costhe*eul[4]*cosphi; + + /* Use an alternative formula for greater numerical accuracy. */ + if (fabs(z) > 0.99) { + if (z < 0) + *lat = -acosdeg (sqrt(x*x+y*y)); + else + *lat = acosdeg (sqrt(x*x+y*y)); + } else { + *lat = asindeg (z); + } + } + + return 0; +} +/* Dec 20 1999 Doug Mink - Change cosd() and sind() to cosdeg() and sindeg() + * Dec 20 1999 Doug Mink - Include wcslib.h, which includes wcstrig.h, sph.h + * Dec 20 1999 Doug Mink - Define copysign only if it is not already defined + * + * Jan 5 2000 Doug Mink - Drop copysign + * + * Sep 19 2001 Doug Mink - No change for WCSLIB 2.7 + */ diff --git a/tksao/wcssubs/tnxpos.c b/tksao/wcssubs/tnxpos.c new file mode 100644 index 0000000..e13d78e --- /dev/null +++ b/tksao/wcssubs/tnxpos.c @@ -0,0 +1,1234 @@ +/*** File wcslib/tnxpos.c + *** September 17, 2008 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** After IRAF mwcs/wftnx.x and mwcs/wfgsurfit.x + *** Copyright (C) 1998-2008 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +#include <stdio.h> +#include <stdlib.h> +#include <math.h> +#include "wcs.h" + +#define SPHTOL 0.00001 +#define BADCVAL 0.0 +#define MAX(a,b) (((a) > (b)) ? (a) : (b)) +#define MIN(a,b) (((a) < (b)) ? (a) : (b)) + +/* wftnx -- wcs function driver for the gnomonic projection with correction. + * tnxinit (header, wcs) + * tnxclose (wcs) + * tnxfwd (xpix, ypix, wcs, xpos, ypos) Pixels to WCS + * tnxrev (xpos, ypos, wcs, xpix, ypix) WCS to pixels + */ + +#define max_niter 500 +#define SZ_ATSTRING 2000 +static void wf_gsclose(); +static void wf_gsb1pol(); +static void wf_gsb1leg(); +static void wf_gsb1cheb(); + +/* tnxinit -- initialize the gnomonic forward or inverse transform. + * initialization for this transformation consists of, determining which + * axis is ra / lon and which is dec / lat, computing the celestial longitude + * and colatitude of the native pole, reading in the the native longitude + * of the pole of the celestial coordinate system longpole from the attribute + * list, precomputing euler angles and various intermediaries derived from the + * coordinate reference values, and reading in the projection parameter ro + * from the attribute list. if longpole is undefined then a value of 180.0 + * degrees is assumed. if ro is undefined a value of 180.0 / pi is assumed. + * the tan projection is equivalent to the azp projection with mu set to 0.0. + * in order to determine the axis order, the parameter "axtype={ra|dec} + * {xlon|glat}{xlon|elat}" must have been set in the attribute list for the + * function. the longpole and ro parameters may be set in either or both of + * the axes attribute lists, but the value in the ra axis attribute list takes + * precedence. + */ + +int +tnxinit (header, wcs) + +const char *header; /* FITS header */ +struct WorldCoor *wcs; /* pointer to WCS structure */ +{ + struct IRAFsurface *wf_gsopen(); + char *str1, *str2, *lngstr, *latstr; + extern void wcsrotset(); + + /* allocate space for the attribute strings */ + str1 = malloc (SZ_ATSTRING); + str2 = malloc (SZ_ATSTRING); + hgetm (header, "WAT1", SZ_ATSTRING, str1); + hgetm (header, "WAT2", SZ_ATSTRING, str2); + + lngstr = malloc (SZ_ATSTRING); + latstr = malloc (SZ_ATSTRING); + + /* determine the native longitude of the pole of the celestial + coordinate system corresponding to the FITS keyword longpole. + this number has no default and should normally be set to 180 + degrees. search both axes for this quantity. */ + + if (wcs->longpole > 360.0) { + if (!igetr8 (str1, "longpole", &wcs->longpole)) { + if (!igetr8 (str2, "longpole", &wcs->longpole)) + wcs->longpole = 180.0; + } + } + + /* Fetch the ro projection parameter which is the radius of the + generating sphere for the projection. if ro is absent which + is the usual case set it to 180 / pi. search both axes for + this quantity. */ + + if (!igetr8 (str1, "ro", &wcs->rodeg)) { + if (!igetr8 (str2, "ro", &wcs->rodeg)) + wcs->rodeg = 180.0 / PI; + } + + /* Fetch the longitude correction surface. note that the attribute + string may be of any length so the length of atvalue may have + to be adjusted. */ + + if (!igets (str1, "lngcor", SZ_ATSTRING, lngstr)) { + if (!igets (str2, "lngcor", SZ_ATSTRING, lngstr)) + wcs->lngcor = NULL; + else + wcs->lngcor = wf_gsopen (lngstr); + } + else + wcs->lngcor = wf_gsopen (lngstr); + + /* Fetch the latitude correction surface. note that the attribute + string may be of any length so the length of atvalue may have + to be adjusted. */ + + if (!igets (str2, "latcor", SZ_ATSTRING, latstr)) { + if (!igets (str1, "latcor", SZ_ATSTRING, latstr)) + wcs->latcor = NULL; + else + wcs->latcor = wf_gsopen (latstr); + } + else + wcs->latcor = wf_gsopen (latstr); + + /* Compute image rotation */ + wcsrotset (wcs); + + /* free working space. */ + free (str1); + free (str2); + free (lngstr); + free (latstr); + + /* Return 1 if there are no correction coefficients */ + if (wcs->latcor == NULL && wcs->lngcor == NULL) + return (1); + else + return (0); +} + + +/* tnxpos -- forward transform (physical to world) gnomonic projection. */ + +int +tnxpos (xpix, ypix, wcs, xpos, ypos) + +double xpix, ypix; /*i physical coordinates (x, y) */ +struct WorldCoor *wcs; /*i pointer to WCS descriptor */ +double *xpos, *ypos; /*o world coordinates (ra, dec) */ +{ + int ira, idec; + double x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, dlng, z; + double colatp, coslatp, sinlatp, longp; + double xs, ys, ra, dec, xp, yp; + double wf_gseval(); + + /* Convert from pixels to image coordinates */ + xpix = xpix - wcs->crpix[0]; + ypix = ypix - wcs->crpix[1]; + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + x = xpix * wcs->cd[0] + ypix * wcs->cd[1]; + y = xpix * wcs->cd[2] + ypix * wcs->cd[3]; + } + + else { + + /* Check axis increments - bail out if either 0 */ + if (wcs->cdelt[0] == 0.0 || wcs->cdelt[1] == 0.0) { + *xpos = 0.0; + *ypos = 0.0; + return 2; + } + + /* Scale using CDELT */ + xs = xpix * wcs->cdelt[0]; + ys = ypix * wcs->cdelt[1]; + + /* Take out rotation from CROTA */ + if (wcs->rot != 0.0) { + double cosr = cos (degrad (wcs->rot)); + double sinr = sin (degrad (wcs->rot)); + x = xs * cosr - ys * sinr; + y = xs * sinr + ys * cosr; + } + else { + x = xs; + y = ys; + } + } + + /* get the axis numbers */ + if (wcs->coorflip) { + ira = 1; + idec = 0; + } + else { + ira = 0; + idec = 1; + } + colatp = degrad (90.0 - wcs->crval[idec]); + coslatp = cos(colatp); + sinlatp = sin(colatp); + longp = degrad(wcs->longpole); + + /* Compute native spherical coordinates phi and theta in degrees from the + projected coordinates. this is the projection part of the computation */ + if (wcs->lngcor != NULL) + xp = x + wf_gseval (wcs->lngcor, x, y); + else + xp = x; + if (wcs->latcor != NULL) + yp = y + wf_gseval (wcs->latcor, x, y); + else + yp = y; + x = xp; + y = yp; + r = sqrt (x * x + y * y); + + /* Compute phi */ + if (r == 0.0) + phi = 0.0; + else + phi = atan2 (x, -y); + + /* Compute theta */ + theta = atan2 (wcs->rodeg, r); + + /* Compute the celestial coordinates ra and dec from the native + coordinates phi and theta. this is the spherical geometry part + of the computation */ + + costhe = cos (theta); + sinthe = sin (theta); + dphi = phi - longp; + cosphi = cos (dphi); + sinphi = sin (dphi); + + /* Compute the ra */ + x = sinthe * sinlatp - costhe * coslatp * cosphi; + if (fabs (x) < SPHTOL) + x = -cos (theta + colatp) + costhe * coslatp * (1.0 - cosphi); + y = -costhe * sinphi; + if (x != 0.0 || y != 0.0) + dlng = atan2 (y, x); + else + dlng = dphi + PI ; + ra = wcs->crval[ira] + raddeg(dlng); + + /* normalize ra */ + if (wcs->crval[ira] >= 0.0) { + if (ra < 0.0) + ra = ra + 360.0; + } + else { + if (ra > 0.0) + ra = ra - 360.0; + } + if (ra > 360.0) + ra = ra - 360.0; + else if (ra < -360.0) + ra = ra + 360.0; + + /* compute the dec */ + if (fmod (dphi, PI) == 0.0) { + dec = raddeg(theta + cosphi * colatp); + if (dec > 90.0) + dec = 180.0 - dec; + if (dec < -90.0) + dec = -180.0 - dec; + } + else { + z = sinthe * coslatp + costhe * sinlatp * cosphi; + if (fabs(z) > 0.99) { + if (z >= 0.0) + dec = raddeg(acos (sqrt(x * x + y * y))); + else + dec = raddeg(-acos (sqrt(x * x + y * y))); + } + else + dec = raddeg(asin (z)); + } + + /* store the results */ + *xpos = ra; + *ypos = dec; + return (0); +} + + +/* tnxpix -- inverse transform (world to physical) gnomonic projection */ + +int +tnxpix (xpos, ypos, wcs, xpix, ypix) + +double xpos, ypos; /*i world coordinates (ra, dec) */ +struct WorldCoor *wcs; /*i pointer to WCS descriptor */ +double *xpix, *ypix; /*o physical coordinates (x, y) */ +{ + int ira, idec, niter; + double ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta; + double s, r, dphi, z, dpi, dhalfpi, twopi, tx; + double xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy; + double colatp, coslatp, sinlatp, longp, sphtol; + double wf_gseval(), wf_gsder(); + + /* get the axis numbers */ + if (wcs->coorflip) { + ira = 1; + idec = 0; + } + else { + ira = 0; + idec = 1; + } + + /* Compute the transformation from celestial coordinates ra and + dec to native coordinates phi and theta. this is the spherical + geometry part of the transformation */ + + ra = degrad (xpos - wcs->crval[ira]); + dec = degrad (ypos); + cosra = cos (ra); + sinra = sin (ra); + cosdec = cos (dec); + sindec = sin (dec); + colatp = degrad (90.0 - wcs->crval[idec]); + coslatp = cos (colatp); + sinlatp = sin (colatp); + if (wcs->longpole == 999.0) + longp = degrad (180.0); + else + longp = degrad(wcs->longpole); + dpi = PI; + dhalfpi = dpi * 0.5; + twopi = PI + PI; + sphtol = SPHTOL; + + /* Compute phi */ + x = sindec * sinlatp - cosdec * coslatp * cosra; + if (fabs(x) < sphtol) + x = -cos (dec + colatp) + cosdec * coslatp * (1.0 - cosra); + y = -cosdec * sinra; + if (x != 0.0 || y != 0.0) + dphi = atan2 (y, x); + else + dphi = ra - dpi; + phi = longp + dphi; + if (phi > dpi) + phi = phi - twopi; + else if (phi < -dpi) + phi = phi + twopi; + + /* Compute theta */ + if (fmod (ra, dpi) == 0.0) { + theta = dec + cosra * colatp; + if (theta > dhalfpi) + theta = dpi - theta; + if (theta < -dhalfpi) + theta = -dpi - theta; + } + else { + z = sindec * coslatp + cosdec * sinlatp * cosra; + if (fabs (z) > 0.99) { + if (z >= 0.0) + theta = acos (sqrt(x * x + y * y)); + else + theta = -acos (sqrt(x * x + y * y)); + } + else + theta = asin (z); + } + + /* Compute the transformation from native coordinates phi and theta + to projected coordinates x and y */ + + s = sin (theta); + if (s == 0.0) { + x = BADCVAL; + y = BADCVAL; + } + else { + r = wcs->rodeg * cos (theta) / s; + if (wcs->lngcor == NULL && wcs->latcor == NULL) { + if (wcs->coorflip) { + y = r * sin (phi); + x = -r * cos (phi); + } + else { + x = r * sin (phi); + y = -r * cos (phi); + } + } + else { + xm = r * sin (phi); + ym = -r * cos (phi); + x = xm; + y = ym; + niter = 0; + while (niter < max_niter) { + if (wcs->lngcor != NULL) { + f = x + wf_gseval (wcs->lngcor, x, y) - xm; + fx = wf_gsder (wcs->lngcor, x, y, 1, 0); + fx = 1.0 + fx; + fy = wf_gsder (wcs->lngcor, x, y, 0, 1); + } + else { + f = x - xm; + fx = 1.0 ; + fy = 0.0; + } + if (wcs->latcor != NULL) { + g = y + wf_gseval (wcs->latcor, x, y) - ym; + gx = wf_gsder (wcs->latcor, x, y, 1, 0); + gy = wf_gsder (wcs->latcor, x, y, 0, 1); + gy = 1.0 + gy; + } + else { + g = y - ym; + gx = 0.0 ; + gy = 1.0; + } + + denom = fx * gy - fy * gx; + if (denom == 0.0) + break; + dx = (-f * gy + g * fy) / denom; + dy = (-g * fx + f * gx) / denom; + x = x + dx; + y = y + dy; + if (MAX(MAX(fabs(dx),fabs(dy)),MAX(fabs(f),fabs(g))) < 2.80e-8) + break; + + niter = niter + 1; + } + + /* Reverse x and y if axes flipped */ + if (wcs->coorflip) { + tx = x; + x = y; + y = tx; + } + } + } + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + *xpix = x * wcs->dc[0] + y * wcs->dc[1]; + *ypix = x * wcs->dc[2] + y * wcs->dc[3]; + } + + else { + + /* Correct for rotation */ + if (wcs->rot!=0.0) { + double cosr = cos (degrad (wcs->rot)); + double sinr = sin (degrad (wcs->rot)); + *xpix = x * cosr + y * sinr; + *ypix = y * cosr - x * sinr; + } + else { + *xpix = x; + *ypix = y; + } + + /* Scale using CDELT */ + if (wcs->xinc != 0.) + *xpix = *xpix / wcs->xinc; + if (wcs->yinc != 0.) + *ypix = *ypix / wcs->yinc; + } + + /* Convert to pixels */ + *xpix = *xpix + wcs->xrefpix; + *ypix = *ypix + wcs->yrefpix; + + return (0); +} + + +/* TNXCLOSE -- free up the distortion surface pointers */ + +void +tnxclose (wcs) + +struct WorldCoor *wcs; /* pointer to the WCS descriptor */ + +{ + if (wcs->lngcor != NULL) + wf_gsclose (wcs->lngcor); + if (wcs->latcor != NULL) + wf_gsclose (wcs->latcor); + return; +} + +/* copyright(c) 1986 association of universities for research in astronomy inc. + * wfgsurfit.x -- surface fitting package used by wcs function drivers. + * Translated to C from SPP by Jessica Mink, SAO, May 26, 1998 + * + * the following routines are used by the experimental function drivers tnx + * and zpx to decode polynomial fits stored in the image header in the form + * of a list of parameters and coefficients into surface descriptors in + * ra / dec or longitude latitude. the polynomial surfaces so encoded consist + * of corrections to function drivers tan and zpn. the package routines are + * modelled after the equivalent gsurfit routines and are consistent with them. + * the routines are: + * + * sf = wf_gsopen (wattstr) + * wf_gsclose (sf) + * + * z = wf_gseval (sf, x, y) + * ncoeff = wf_gscoeff (sf, coeff) + * zder = wf_gsder (sf, x, y, nxder, nyder) + * + * wf_gsopen is used to open a surface fit encoded in a wcs attribute, returning + * the sf surface fitting descriptor. wf_gsclose should be called later to free + * the descriptor. wf_gseval is called to evaluate the surface at a point. + */ + + +#define SZ_GSCOEFFBUF 20 + +/* define the structure elements for the wf_gsrestore task */ +#define TNX_SAVETYPE 0 +#define TNX_SAVEXORDER 1 +#define TNX_SAVEYORDER 2 +#define TNX_SAVEXTERMS 3 +#define TNX_SAVEXMIN 4 +#define TNX_SAVEXMAX 5 +#define TNX_SAVEYMIN 6 +#define TNX_SAVEYMAX 7 +#define TNX_SAVECOEFF 8 + + +/* wf_gsopen -- decode the longitude / latitude or ra / dec mwcs attribute + * and return a gsurfit compatible surface descriptor. + */ + +struct IRAFsurface * +wf_gsopen (astr) + +char *astr; /* the input mwcs attribute string */ + +{ + double dval; + char *estr; + int npar, szcoeff; + double *coeff; + struct IRAFsurface *gs; + struct IRAFsurface *wf_gsrestore(); + + if (astr[1] == 0) + return (NULL); + + gs = NULL; + npar = 0; + szcoeff = SZ_GSCOEFFBUF; + coeff = (double *) malloc (szcoeff * sizeof (double)); + + estr = astr; + while (*estr != (char) 0) { + dval = strtod (astr, &estr); + if (*estr == '.') + estr++; + if (*estr != (char) 0) { + npar++; + if (npar >= szcoeff) { + szcoeff = szcoeff + SZ_GSCOEFFBUF; + coeff = (double *) realloc (coeff, (szcoeff * sizeof (double))); + } + coeff[npar-1] = dval; + astr = estr; + while (*astr == ' ') astr++; + } + } + + gs = wf_gsrestore (coeff); + + free (coeff); + + if (npar == 0) + return (NULL); + else + return (gs); +} + + +/* wf_gsclose -- procedure to free the surface descriptor */ + +static void +wf_gsclose (sf) + +struct IRAFsurface *sf; /* the surface descriptor */ + +{ + if (sf != NULL) { + if (sf->xbasis != NULL) + free (sf->xbasis); + if (sf->ybasis != NULL) + free (sf->ybasis); + if (sf->coeff != NULL) + free (sf->coeff); + free (sf); + } + return; +} + + +/* wf_gseval -- procedure to evaluate the fitted surface at a single point. + * the wf->ncoeff coefficients are stored in the vector pointed to by sf->coeff. + */ + +double +wf_gseval (sf, x, y) + +struct IRAFsurface *sf; /* pointer to surface descriptor structure */ +double x; /* x value */ +double y; /* y value */ +{ + double sum, accum; + int i, ii, k, maxorder, xorder; + + /* Calculate the basis functions */ + switch (sf->type) { + case TNX_CHEBYSHEV: + wf_gsb1cheb (x, sf->xorder, sf->xmaxmin, sf->xrange, sf->xbasis); + wf_gsb1cheb (y, sf->yorder, sf->ymaxmin, sf->yrange, sf->ybasis); + break; + case TNX_LEGENDRE: + wf_gsb1leg (x, sf->xorder, sf->xmaxmin, sf->xrange, sf->xbasis); + wf_gsb1leg (y, sf->yorder, sf->ymaxmin, sf->yrange, sf->ybasis); + break; + case TNX_POLYNOMIAL: + wf_gsb1pol (x, sf->xorder, sf->xbasis); + wf_gsb1pol (y, sf->yorder, sf->ybasis); + break; + default: + fprintf (stderr,"TNX_GSEVAL: unknown surface type\n"); + return (0.0); + } + + /* Initialize accumulator basis functions */ + sum = 0.0; + + /* Loop over y basis functions */ + if (sf->xorder > sf->yorder) + maxorder = sf->xorder + 1; + else + maxorder = sf->yorder + 1; + xorder = sf->xorder; + ii = 0; + + for (i = 0; i < sf->yorder; i++) { + + /* Loop over the x basis functions */ + accum = 0.0; + for (k = 0; k < xorder; k++) { + accum = accum + sf->coeff[ii] * sf->xbasis[k]; + ii = ii + 1; + } + accum = accum * sf->ybasis[i]; + sum = sum + accum; + + /* Elements of the coefficient vector where neither k = 1 or i = 1 + are not calculated if sf->xterms = no. */ + if (sf->xterms == TNX_XNONE) + xorder = 1; + else if (sf->xterms == TNX_XHALF) { + if ((i + 1 + sf->xorder + 1) > maxorder) + xorder = xorder - 1; + } + } + + return (sum); +} + + +/* TNX_GSCOEFF -- procedure to fetch the number and magnitude of the coefficients + * if the sf->xterms = wf_xbi (yes) then the number of coefficients will be + * (sf->xorder * sf->yorder); if wf_xterms is wf_xtri then the number + * of coefficients will be (sf->xorder * sf->yorder - order * + * (order - 1) / 2) where order is the minimum of the x and yorders; if + * sf->xterms = TNX_XNONE then the number of coefficients will be + * (sf->xorder + sf->yorder - 1). + */ + +int +wf_gscoeff (sf, coeff) + +struct IRAFsurface *sf; /* pointer to the surface fitting descriptor */ +double *coeff; /* the coefficients of the fit */ + +{ + int ncoeff; /* the number of coefficients */ + int i; + + /* Exctract coefficients from data structure and calculate their number */ + ncoeff = sf->ncoeff; + for (i = 0; i < ncoeff; i++) + coeff[i] = sf->coeff[i]; + return (ncoeff); +} + + +static double *coeff = NULL; +static int nbcoeff = 0; + +/* wf_gsder -- procedure to calculate a new surface which is a derivative of + * the input surface. + */ + +double +wf_gsder (sf1, x, y, nxd, nyd) + +struct IRAFsurface *sf1; /* pointer to the previous surface */ +double x; /* x values */ +double y; /* y values */ +int nxd, nyd; /* order of the derivatives in x and y */ +{ + int nxder, nyder, i, j, k, nbytes; + int order, maxorder1, maxorder2, nmove1, nmove2; + struct IRAFsurface *sf2 = 0; + double *ptr1, *ptr2; + double zfit, norm; + double wf_gseval(); + + if (sf1 == NULL) + return (0.0); + + if (nxd < 0 || nyd < 0) { + fprintf (stderr, "TNX_GSDER: order of derivatives cannot be < 0\n"); + return (0.0); + } + + if (nxd == 0 && nyd == 0) { + zfit = wf_gseval (sf1, x, y); + return (zfit); + } + + /* Allocate space for new surface */ + sf2 = (struct IRAFsurface *) malloc (sizeof (struct IRAFsurface)); + + /* Check the order of the derivatives */ + nxder = MIN (nxd, sf1->xorder - 1); + nyder = MIN (nyd, sf1->yorder - 1); + + /* Set up new surface */ + sf2->type = sf1->type; + + /* Set the derivative surface parameters */ + if (sf2->type == TNX_LEGENDRE || + sf2->type == TNX_CHEBYSHEV || + sf2->type == TNX_POLYNOMIAL) { + + sf2->xterms = sf1->xterms; + + /* Find the order of the new surface */ + switch (sf2->xterms) { + case TNX_XNONE: + if (nxder > 0 && nyder > 0) { + sf2->xorder = 1; + sf2->yorder = 1; + sf2->ncoeff = 1; + } + else if (nxder > 0) { + sf2->xorder = MAX (1, sf1->xorder - nxder); + sf2->yorder = 1; + sf2->ncoeff = sf2->xorder; + } + else if (nyder > 0) { + sf2->xorder = 1; + sf2->yorder = MAX (1, sf1->yorder - nyder); + sf2->ncoeff = sf2->yorder; + } + break; + + case TNX_XHALF: + maxorder1 = MAX (sf1->xorder+1, sf1->yorder+1); + order = MAX(1, MIN(maxorder1-1-nyder-nxder,sf1->xorder-nxder)); + sf2->xorder = order; + order = MAX(1, MIN(maxorder1-1-nyder-nxder,sf1->yorder-nyder)); + sf2->yorder = order; + order = MIN (sf2->xorder, sf2->yorder); + sf2->ncoeff = sf2->xorder * sf2->yorder - (order*(order-1)/2); + break; + + default: + sf2->xorder = MAX (1, sf1->xorder - nxder); + sf2->yorder = MAX (1, sf1->yorder - nyder); + sf2->ncoeff = sf2->xorder * sf2->yorder; + } + + /* define the data limits */ + sf2->xrange = sf1->xrange; + sf2->xmaxmin = sf1->xmaxmin; + sf2->yrange = sf1->yrange; + sf2->ymaxmin = sf1->ymaxmin; + } + + else { + fprintf (stderr, "TNX_GSDER: unknown surface type %d\n", sf2->type); + return (0.0); + } + + /* Allocate space for coefficients and basis functions */ + nbytes = sf2->ncoeff * sizeof(double); + sf2->coeff = (double *) malloc (nbytes); + nbytes = sf2->xorder * sizeof(double); + sf2->xbasis = (double *) malloc (nbytes); + nbytes = sf2->yorder * sizeof(double); + sf2->ybasis = (double *) malloc (nbytes); + + /* Get coefficients */ + nbytes = sf1->ncoeff * sizeof(double); + if (nbytes > nbcoeff) { + if (nbcoeff > 0) + coeff = (double *) realloc (coeff, nbytes); + else + coeff = (double *) malloc (nbytes); + nbcoeff = nbytes; + } + (void) wf_gscoeff (sf1, coeff); + + /* Compute the new coefficients */ + switch (sf2->xterms) { + case TNX_XFULL: + ptr2 = sf2->coeff + (sf2->yorder - 1) * sf2->xorder; + ptr1 = coeff + (sf1->yorder - 1) * sf1->xorder; + for (i = sf1->yorder - 1; i >= nyder; i--) { + for (j = i; j >= i-nyder+1; j--) { + for (k = 0; k < sf2->xorder; k++) + ptr1[nxder+k] = ptr1[nxder+k] * (double)(j); + } + for (j = sf1->xorder; j >= nxder+1; j--) { + for (k = j; k >= j-nxder+1; k--) + ptr1[j-1] = ptr1[j-1] * (double)(k - 1); + } + for (j = 0; j < sf2->xorder; j++) + ptr2[j] = ptr1[nxder+j]; + ptr2 = ptr2 - sf2->xorder; + ptr1 = ptr1 - sf1->xorder; + } + break; + + case TNX_XHALF: + maxorder1 = MAX (sf1->xorder + 1, sf1->yorder + 1); + maxorder2 = MAX (sf2->xorder + 1, sf2->yorder + 1); + ptr2 = sf2->coeff + sf2->ncoeff; + ptr1 = coeff + sf1->ncoeff; + for (i = sf1->yorder; i >= nyder+1; i--) { + nmove1 = MAX (0, MIN (maxorder1 - i, sf1->xorder)); + nmove2 = MAX (0, MIN (maxorder2 - i + nyder, sf2->xorder)); + ptr1 = ptr1 - nmove1; + ptr2 = ptr2 - nmove2; + for (j = i; j > i - nyder + 1; j--) { + for (k = 0; k < nmove2; k++) + ptr1[nxder+k] = ptr1[nxder+k] * (double)(j-1); + } + for (j = nmove1; j >= nxder+1; j--) { + for (k = j; k >= j-nxder+1; k--) + ptr1[j-1] = ptr1[j-1] * (double)(k - 1); + } + for (j = 0; j < nmove2; j++) + ptr2[j] = ptr1[nxder+j]; + } + break; + + default: + if (nxder > 0 && nyder > 0) + sf2->coeff[0] = 0.0; + + else if (nxder > 0) { + ptr1 = coeff; + ptr2 = sf2->coeff + sf2->ncoeff - 1; + for (j = sf1->xorder; j >= nxder+1; j--) { + for (k = j; k >= j - nxder + 1; k--) + ptr1[j-1] = ptr1[j-1] * (double)(k - 1); + ptr2[0] = ptr1[j-1]; + ptr2 = ptr2 - 1; + } + } + + else if (nyder > 0) { + ptr1 = coeff + sf1->ncoeff - 1; + ptr2 = sf2->coeff; + for (i = sf1->yorder; i >= nyder + 1; i--) { + for (j = i; j >= i - nyder + 1; j--) + *ptr1 = *ptr1 * (double)(j - 1); + ptr1 = ptr1 - 1; + } + for (i = 0; i < sf2->ncoeff; i++) + ptr2[i] = ptr1[i+1]; + } + } + + /* evaluate the derivatives */ + zfit = wf_gseval (sf2, x, y); + + /* normalize */ + if (sf2->type != TNX_POLYNOMIAL) { + norm = pow (sf2->xrange, (double)nxder) * + pow (sf2->yrange, (double)nyder); + zfit = norm * zfit; + } + + /* free the space */ + wf_gsclose (sf2); + + return (zfit); +} + + +/* wf_gsrestore -- procedure to restore the surface fit encoded in the + image header as a list of double precision parameters and coefficients + to the surface descriptor for use by the evaluating routines. the + surface parameters, surface type, xorder (or number of polynomial + terms in x), yorder (or number of polynomial terms in y), xterms, + xmin, xmax and ymin and ymax, are stored in the first eight elements + of the double array fit, followed by the wf->ncoeff surface coefficients. + */ + +struct IRAFsurface * +wf_gsrestore (fit) + +double *fit; /* array containing the surface parameters + and coefficients */ +{ + struct IRAFsurface *sf; /* surface descriptor */ + int surface_type, xorder, yorder, order, i; + double xmin, xmax, ymin, ymax; + + xorder = (int) (fit[TNX_SAVEXORDER] + 0.5); + if (xorder < 1) { + fprintf (stderr, "wf_gsrestore: illegal x order %d\n", xorder); + return (NULL); + } + + yorder = (int) (fit[TNX_SAVEYORDER] + 0.5); + if (yorder < 1) { + fprintf (stderr, "wf_gsrestore: illegal y order %d\n", yorder); + return (NULL); + } + + xmin = fit[TNX_SAVEXMIN]; + xmax = fit[TNX_SAVEXMAX]; + if (xmax <= xmin) { + fprintf (stderr, "wf_gsrestore: illegal x range %f-%f\n",xmin,xmax); + return (NULL); + } + ymin = fit[TNX_SAVEYMIN]; + ymax = fit[TNX_SAVEYMAX]; + if (ymax <= ymin) { + fprintf (stderr, "wf_gsrestore: illegal y range %f-%f\n",ymin,ymax); + return (NULL); + } + + /* Set surface type dependent surface descriptor parameters */ + surface_type = (int) (fit[TNX_SAVETYPE] + 0.5); + + if (surface_type == TNX_LEGENDRE || + surface_type == TNX_CHEBYSHEV || + surface_type == TNX_POLYNOMIAL) { + + /* allocate space for the surface descriptor */ + sf = (struct IRAFsurface *) malloc (sizeof (struct IRAFsurface)); + sf->xorder = xorder; + sf->xrange = 2.0 / (xmax - xmin); + sf->xmaxmin = - (xmax + xmin) / 2.0; + sf->yorder = yorder; + sf->yrange = 2.0 / (ymax - ymin); + sf->ymaxmin = - (ymax + ymin) / 2.0; + sf->xterms = fit[TNX_SAVEXTERMS]; + switch (sf->xterms) { + case TNX_XNONE: + sf->ncoeff = sf->xorder + sf->yorder - 1; + break; + case TNX_XHALF: + order = MIN (xorder, yorder); + sf->ncoeff = sf->xorder * sf->yorder - order * (order-1) / 2; + break; + case TNX_XFULL: + sf->ncoeff = sf->xorder * sf->yorder; + break; + } + } + else { + fprintf (stderr, "wf_gsrestore: unknown surface type %d\n", surface_type); + return (NULL); + } + + /* Set remaining curve parameters */ + sf->type = surface_type; + + /* Restore coefficient array */ + sf->coeff = (double *) malloc (sf->ncoeff*sizeof (double)); + for (i = 0; i < sf->ncoeff; i++) + sf->coeff[i] = fit[TNX_SAVECOEFF+i]; + + /* Allocate space for basis vectors */ + sf->xbasis = (double *) malloc (sf->xorder*sizeof (double)); + sf->ybasis = (double *) malloc (sf->yorder*sizeof (double)); + + return (sf); +} + + +/* wf_gsb1pol -- procedure to evaluate all the non-zero polynomial functions + for a single point and given order. */ + +static void +wf_gsb1pol (x, order, basis) + +double x; /*i data point */ +int order; /*i order of polynomial, order = 1, constant */ +double *basis; /*o basis functions */ +{ + int i; + + basis[0] = 1.0; + if (order == 1) + return; + + basis[1] = x; + if (order == 2) + return; + + for (i = 2; i < order; i++) + basis[i] = x * basis[i-1]; + + return; +} + + +/* wf_gsb1leg -- procedure to evaluate all the non-zero legendre functions for + a single point and given order. */ + +static void +wf_gsb1leg (x, order, k1, k2, basis) + +double x; /*i data point */ +int order; /*i order of polynomial, order = 1, constant */ +double k1, k2; /*i normalizing constants */ +double *basis; /*o basis functions */ +{ + int i; + double ri, xnorm; + + basis[0] = 1.0; + if (order == 1) + return; + + xnorm = (x + k1) * k2 ; + basis[1] = xnorm; + if (order == 2) + return; + + for (i = 2; i < order; i++) { + ri = i; + basis[i] = ((2.0 * ri - 1.0) * xnorm * basis[i-1] - + (ri - 1.0) * basis[i-2]) / ri; + } + + return; +} + + +/* wf_gsb1cheb -- procedure to evaluate all the non-zero chebyshev function + coefficients for a given x and order. */ + +static void +wf_gsb1cheb (x, order, k1, k2, basis) + +double x; /*i number of data points */ +int order; /*i order of polynomial, 1 is a constant */ +double k1, k2; /*i normalizing constants */ +double *basis; /*o array of basis functions */ +{ + int i; + double xnorm; + + basis[0] = 1.0; + if (order == 1) + return; + + xnorm = (x + k1) * k2; + basis[1] = xnorm; + if (order == 2) + return; + + for (i = 2; i < order; i++) + basis[i] = 2. * xnorm * basis[i-1] - basis[i-2]; + + return; +} + +/* Set surface polynomial from arguments */ + +int +tnxpset (wcs, xorder, yorder, xterms, coeff) + +struct WorldCoor *wcs; /* World coordinate system structure */ +int xorder; /* Number of x coefficients (same for x and y) */ +int yorder; /* Number of y coefficients (same for x and y) */ +int xterms; /* Number of xy coefficients (same for x and y) */ +double *coeff; /* Plate fit coefficients */ + +{ + double *ycoeff; + struct IRAFsurface *wf_gspset (); + + wcs->prjcode = WCS_TNX; + + wcs->lngcor = wf_gspset (xorder, yorder, xterms, coeff); + ycoeff = coeff + wcs->lngcor->ncoeff; + wcs->latcor = wf_gspset (xorder, yorder, xterms, ycoeff); + + return 0; +} + + +/* wf_gspset -- procedure to set the surface descriptor for use by the + evaluating routines. from arguments. The surface parameters are + surface type, xorder (number of polynomial terms in x), yorder (number + of polynomial terms in y), xterms, and the surface coefficients. + */ + +struct IRAFsurface * +wf_gspset (xorder, yorder, xterms, coeff) + +int xorder; +int yorder; +int xterms; +double *coeff; +{ + struct IRAFsurface *sf; /* surface descriptor */ + int surface_type, order, i; + double xmin, xmax; + double ymin, ymax; + + surface_type = TNX_POLYNOMIAL; + xmin = 0.0; + xmax = 0.0; + ymin = 0.0; + ymax = 0.0; + + if (surface_type == TNX_LEGENDRE || + surface_type == TNX_CHEBYSHEV || + surface_type == TNX_POLYNOMIAL) { + + /* allocate space for the surface descriptor */ + sf = (struct IRAFsurface *) malloc (sizeof (struct IRAFsurface)); + sf->xorder = xorder; + sf->xrange = 2.0 / (xmax - xmin); + sf->xmaxmin = -(xmax + xmin) / 2.0; + sf->yorder = yorder; + sf->yrange = 2.0 / (ymax - ymin); + sf->ymaxmin = - (ymax + ymin) / 2.0; + sf->xterms = xterms; + switch (sf->xterms) { + case TNX_XNONE: + sf->ncoeff = sf->xorder + sf->yorder - 1; + break; + case TNX_XHALF: + order = MIN (xorder, yorder); + sf->ncoeff = sf->xorder * sf->yorder - order * (order-1) / 2; + break; + case TNX_XFULL: + sf->ncoeff = sf->xorder * sf->yorder; + break; + } + } + else { + fprintf (stderr, "TNX_GSSET: unknown surface type %d\n", surface_type); + return (NULL); + } + + /* Set remaining curve parameters */ + sf->type = surface_type; + + /* Restore coefficient array */ + sf->coeff = (double *) malloc (sf->ncoeff*sizeof (double)); + for (i = 0; i < sf->ncoeff; i++) + sf->coeff[i] = coeff[i]; + + /* Allocate space for basis vectors */ + sf->xbasis = (double *) malloc (sf->xorder*sizeof (double)); + sf->ybasis = (double *) malloc (sf->yorder*sizeof (double)); + + return (sf); +} + +/* Mar 26 1998 New subroutines, translated from SPP + * Apr 28 1998 Change all local flags to TNX_* and projection flag to WCS_TNX + * May 11 1998 Fix use of pole longitude default + * Sep 4 1998 Fix missed assignment in tnxpos from Allen Harris, SAO + * Sep 10 1998 Fix bugs in tnxpix() + * Sep 10 1998 Fix missed assignment in tnxpix from Allen Harris, SAO + * + * Oct 22 1999 Drop unused variables, fix case statements after lint + * Dec 10 1999 Fix bug in gsder() which failed to allocate enough memory + * Dec 10 1999 Compute wcs->rot using wcsrotset() in tnxinit() + * + * Feb 14 2001 Fixed off-by-one bug in legendre evaluation (Mike Jarvis) + * + * Apr 11 2002 Fix bug when .-terminated substring in wf_gsopen() + * Apr 29 2002 Clean up code + * Jun 26 2002 Increase size of WAT strings from 500 to 2000 + * + * Jun 27 2005 Drop unused arguments k1 and k2 from wf_gsb1pol() + * + * Jan 8 2007 Drop unused variable ncoeff in wf_gsder() + * Jan 9 2007 Declare header const char in tnxinit() + * Apr 3 2007 Fix offsets to hit last cooefficient in wf_gsder() + * + * Sep 5 2008 Fix wf_gseval() call in tnxpos() so unmodified x and y are used + * Sep 9 2008 Fix loop in TNX_XFULL section of wf_gsder() + * (last two bugs found by Ed Los) + * Sep 17 2008 Fix tnxpos for null correction case (fix by Ed Los) + */ diff --git a/tksao/wcssubs/wcs.c b/tksao/wcssubs/wcs.c new file mode 100644 index 0000000..b7d0393 --- /dev/null +++ b/tksao/wcssubs/wcs.c @@ -0,0 +1,2994 @@ +/*** File libwcs/wcs.c + *** October 19, 2012 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1994-2012 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: wcs.c (World Coordinate Systems) + * Purpose: Convert FITS WCS to pixels and vice versa: + * Subroutine: wcsxinit (cra,cdec,secpix,xrpix,yrpix,nxpix,nypix,rotate,equinox,epoch,proj) + * sets a WCS structure from arguments + * Subroutine: wcskinit (nxpix,nypix,ctype1,ctype2,crpix1,crpix2,crval1,crval2, + cd,cdelt1,cdelt2,crota,equinox,epoch) + * sets a WCS structure from keyword-based arguments + * Subroutine: wcsreset (wcs,crpix1,crpix2,crval1,crval2,cdelt1,cdelt2,crota,cd, equinox) + * resets an existing WCS structure from arguments + * Subroutine: wcsdeltset (wcs,cdelt1,cdelt2,crota) sets rotation and scaling + * Subroutine: wcscdset (wcs, cd) sets rotation and scaling from a CD matrix + * Subroutine: wcspcset (wcs,cdelt1,cdelt2,pc) sets rotation and scaling + * Subroutine: wcseqset (wcs, equinox) resets an existing WCS structure to new equinox + * Subroutine: iswcs(wcs) returns 1 if WCS structure is filled, else 0 + * Subroutine: nowcs(wcs) returns 0 if WCS structure is filled, else 1 + * Subroutine: wcscent (wcs) prints the image center and size in WCS units + * Subroutine: wcssize (wcs, cra, cdec, dra, ddec) returns image center and size + * Subroutine: wcsfull (wcs, cra, cdec, width, height) returns image center and size + * Subroutine: wcsrange (wcs, ra1, ra2, dec1, dec2) returns image coordinate limits + + * Subroutine: wcsshift (wcs,cra,cdec) resets the center of a WCS structure + * Subroutine: wcsdist (x1,y1,x2,y2) compute angular distance between ra/dec or lat/long + * Subroutine: wcsdiff (x1,y1,x2,y2) compute angular distance between ra/dec or lat/long + * Subroutine: wcscominit (wcs,command) sets up a command format for execution by wcscom + * Subroutine: wcsoutinit (wcs,coor) sets up the coordinate system used by pix2wcs + * Subroutine: getwcsout (wcs) returns current output coordinate system used by pix2wcs + * Subroutine: wcsininit (wcs,coor) sets up the coordinate system used by wcs2pix + * Subroutine: getwcsin (wcs) returns current input coordinate system used by wcs2pix + * Subroutine: setwcsdeg(wcs, new) sets WCS output in degrees or hh:mm:ss + * Subroutine: getradecsys(wcs) returns current coordinate system type + * Subroutine: wcscom (wcs,file,x,y,wcstr) executes a command using the current world coordinates + * Subroutine: setwcslin (wcs, mode) sets output string mode for LINEAR + * Subroutine: pix2wcst (wcs,xpix,ypix,wcstring,lstr) pixels -> sky coordinate string + * Subroutine: pix2wcs (wcs,xpix,ypix,xpos,ypos) pixel coordinates -> sky coordinates + * Subroutine: wcsc2pix (wcs,xpos,ypos,coorsys,xpix,ypix,offscl) sky coordinates -> pixel coordinates + * Subroutine: wcs2pix (wcs,xpos,ypos,xpix,ypix,offscl) sky coordinates -> pixel coordinates + * Subroutine: wcszin (izpix) sets third dimension for pix2wcs() and pix2wcst() + * Subroutine: wcszout (wcs) returns third dimension from wcs2pix() + * Subroutine: setwcsfile (filename) Set file name for error messages + * Subroutine: setwcserr (errmsg) Set error message + * Subroutine: wcserr() Print error message + * Subroutine: setdefwcs (wcsproj) Set flag to choose AIPS or WCSLIB WCS subroutines + * Subroutine: getdefwcs() Get flag to switch between AIPS and WCSLIB subroutines + * Subroutine: savewcscoor (wcscoor) + * Subroutine: getwcscoor() Return preset output default coordinate system + * Subroutine: savewcscom (i, wcscom) Save specified WCS command + * Subroutine: setwcscom (wcs) Initialize WCS commands + * Subroutine: getwcscom (i) Return specified WCS command + * Subroutine: wcsfree (wcs) Free storage used by WCS structure + * Subroutine: freewcscom (wcs) Free storage used by WCS commands + * Subroutine: cpwcs (&header, cwcs) + */ + +#include <string.h> /* strstr, NULL */ +#include <stdio.h> /* stderr */ +#include <math.h> +#include "wcs.h" +#ifndef VMS +#include <stdlib.h> +#endif + +static char wcserrmsg[80]; +static char wcsfile[256]={""}; +static void wcslibrot(); +void wcsrotset(); +static int wcsproj0 = 0; +static int izpix = 0; +static double zpix = 0.0; + +void +wcsfree (wcs) +struct WorldCoor *wcs; /* WCS structure */ +{ + if (nowcs (wcs)) { + + /* Free WCS structure if allocated but not filled */ + if (wcs) + free (wcs); + + return; + } + + /* Free WCS on which this WCS depends */ + if (wcs->wcs) { + wcsfree (wcs->wcs); + wcs->wcs = NULL; + } + + freewcscom (wcs); + if (wcs->wcsname != NULL) + free (wcs->wcsname); + if (wcs->lin.imgpix != NULL) + free (wcs->lin.imgpix); + if (wcs->lin.piximg != NULL) + free (wcs->lin.piximg); + if (wcs->inv_x != NULL) + poly_end (wcs->inv_x); + if (wcs->inv_y != NULL) + poly_end (wcs->inv_y); + free (wcs); + return; +} + +/* Set up a WCS structure from subroutine arguments */ + +struct WorldCoor * +wcsxinit (cra,cdec,secpix,xrpix,yrpix,nxpix,nypix,rotate,equinox,epoch,proj) + +double cra; /* Center right ascension in degrees */ +double cdec; /* Center declination in degrees */ +double secpix; /* Number of arcseconds per pixel */ +double xrpix; /* Reference pixel X coordinate */ +double yrpix; /* Reference pixel X coordinate */ +int nxpix; /* Number of pixels along x-axis */ +int nypix; /* Number of pixels along y-axis */ +double rotate; /* Rotation angle (clockwise positive) in degrees */ +int equinox; /* Equinox of coordinates, 1950 and 2000 supported */ +double epoch; /* Epoch of coordinates, used for FK4/FK5 conversion + * no effect if 0 */ +char *proj; /* Projection */ + +{ + struct WorldCoor *wcs; + double cdelt1, cdelt2; + + wcs = (struct WorldCoor *) calloc (1, sizeof(struct WorldCoor)); + + /* Set WCSLIB flags so that structures will be reinitialized */ + wcs->cel.flag = 0; + wcs->lin.flag = 0; + wcs->wcsl.flag = 0; + + /* Image dimensions */ + wcs->naxis = 2; + wcs->naxes = 2; + wcs->lin.naxis = 2; + wcs->nxpix = nxpix; + wcs->nypix = nypix; + + wcs->wcsproj = wcsproj0; + + wcs->crpix[0] = xrpix; + wcs->crpix[1] = yrpix; + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + wcs->lin.crpix = wcs->crpix; + + wcs->crval[0] = cra; + wcs->crval[1] = cdec; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + wcs->cel.ref[2] = 999.0; + + strcpy (wcs->c1type,"RA"); + strcpy (wcs->c2type,"DEC"); + +/* Allan Brighton: 28.4.98: for backward compat., remove leading "--" */ + while (proj && *proj == '-') + proj++; + strcpy (wcs->ptype,proj); + strcpy (wcs->ctype[0],"RA---"); + strcpy (wcs->ctype[1],"DEC--"); + strcat (wcs->ctype[0],proj); + strcat (wcs->ctype[1],proj); + + if (wcstype (wcs, wcs->ctype[0], wcs->ctype[1])) { + wcsfree (wcs); + return (NULL); + } + + /* Approximate world coordinate system from a known plate scale */ + cdelt1 = -secpix / 3600.0; + cdelt2 = secpix / 3600.0; + wcsdeltset (wcs, cdelt1, cdelt2, rotate); + wcs->lin.cdelt = wcs->cdelt; + wcs->lin.pc = wcs->pc; + + /* Coordinate reference frame and equinox */ + wcs->equinox = (double) equinox; + if (equinox > 1980) + strcpy (wcs->radecsys,"FK5"); + else + strcpy (wcs->radecsys,"FK4"); + if (epoch > 0) + wcs->epoch = epoch; + else + wcs->epoch = 0.0; + wcs->wcson = 1; + + wcs->syswcs = wcscsys (wcs->radecsys); + wcsoutinit (wcs, wcs->radecsys); + wcsininit (wcs, wcs->radecsys); + wcs->eqout = 0.0; + wcs->printsys = 1; + wcs->tabsys = 0; + + /* Initialize special WCS commands */ + setwcscom (wcs); + + return (wcs); +} + + +/* Set up a WCS structure from subroutine arguments based on FITS keywords */ + +struct WorldCoor * +wcskinit (naxis1, naxis2, ctype1, ctype2, crpix1, crpix2, crval1, crval2, + cd, cdelt1, cdelt2, crota, equinox, epoch) + +int naxis1; /* Number of pixels along x-axis */ +int naxis2; /* Number of pixels along y-axis */ +char *ctype1; /* FITS WCS projection for axis 1 */ +char *ctype2; /* FITS WCS projection for axis 2 */ +double crpix1, crpix2; /* Reference pixel coordinates */ +double crval1, crval2; /* Coordinates at reference pixel in degrees */ +double *cd; /* Rotation matrix, used if not NULL */ +double cdelt1, cdelt2; /* scale in degrees/pixel, ignored if cd is not NULL */ +double crota; /* Rotation angle in degrees, ignored if cd is not NULL */ +int equinox; /* Equinox of coordinates, 1950 and 2000 supported */ +double epoch; /* Epoch of coordinates, used for FK4/FK5 conversion + * no effect if 0 */ +{ + struct WorldCoor *wcs; + + wcs = (struct WorldCoor *) calloc (1, sizeof(struct WorldCoor)); + + /* Set WCSLIB flags so that structures will be reinitialized */ + wcs->cel.flag = 0; + wcs->lin.flag = 0; + wcs->wcsl.flag = 0; + + /* Image dimensions */ + wcs->naxis = 2; + wcs->naxes = 2; + wcs->lin.naxis = 2; + wcs->nxpix = naxis1; + wcs->nypix = naxis2; + + wcs->wcsproj = wcsproj0; + + wcs->crpix[0] = crpix1; + wcs->crpix[1] = crpix2; + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + wcs->lin.crpix = wcs->crpix; + + if (wcstype (wcs, ctype1, ctype2)) { + wcsfree (wcs); + return (NULL); + } + if (wcs->latbase == 90) + crval2 = 90.0 - crval2; + else if (wcs->latbase == -90) + crval2 = crval2 - 90.0; + + wcs->crval[0] = crval1; + wcs->crval[1] = crval2; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + wcs->cel.ref[2] = 999.0; + + if (cd != NULL) + wcscdset (wcs, cd); + + else if (cdelt1 != 0.0) + wcsdeltset (wcs, cdelt1, cdelt2, crota); + + else { + wcsdeltset (wcs, 1.0, 1.0, crota); + setwcserr ("WCSRESET: setting CDELT to 1"); + } + wcs->lin.cdelt = wcs->cdelt; + wcs->lin.pc = wcs->pc; + + /* Coordinate reference frame and equinox */ + wcs->equinox = (double) equinox; + if (equinox > 1980) + strcpy (wcs->radecsys,"FK5"); + else + strcpy (wcs->radecsys,"FK4"); + if (epoch > 0) + wcs->epoch = epoch; + else + wcs->epoch = 0.0; + wcs->wcson = 1; + + strcpy (wcs->radecout, wcs->radecsys); + wcs->syswcs = wcscsys (wcs->radecsys); + wcsoutinit (wcs, wcs->radecsys); + wcsininit (wcs, wcs->radecsys); + wcs->eqout = 0.0; + wcs->printsys = 1; + wcs->tabsys = 0; + + /* Initialize special WCS commands */ + setwcscom (wcs); + + return (wcs); +} + + +/* Set projection in WCS structure from FITS keyword values */ + +int +wcstype (wcs, ctype1, ctype2) + +struct WorldCoor *wcs; /* World coordinate system structure */ +char *ctype1; /* FITS WCS projection for axis 1 */ +char *ctype2; /* FITS WCS projection for axis 2 */ + +{ + int i, iproj; + int nctype = NWCSTYPE; + char ctypes[NWCSTYPE][4]; + char dtypes[10][4]; + + /* Initialize projection types */ + strcpy (ctypes[0], "LIN"); + strcpy (ctypes[1], "AZP"); + strcpy (ctypes[2], "SZP"); + strcpy (ctypes[3], "TAN"); + strcpy (ctypes[4], "SIN"); + strcpy (ctypes[5], "STG"); + strcpy (ctypes[6], "ARC"); + strcpy (ctypes[7], "ZPN"); + strcpy (ctypes[8], "ZEA"); + strcpy (ctypes[9], "AIR"); + strcpy (ctypes[10], "CYP"); + strcpy (ctypes[11], "CAR"); + strcpy (ctypes[12], "MER"); + strcpy (ctypes[13], "CEA"); + strcpy (ctypes[14], "COP"); + strcpy (ctypes[15], "COD"); + strcpy (ctypes[16], "COE"); + strcpy (ctypes[17], "COO"); + strcpy (ctypes[18], "BON"); + strcpy (ctypes[19], "PCO"); + strcpy (ctypes[20], "SFL"); + strcpy (ctypes[21], "PAR"); + strcpy (ctypes[22], "AIT"); + strcpy (ctypes[23], "MOL"); + strcpy (ctypes[24], "CSC"); + strcpy (ctypes[25], "QSC"); + strcpy (ctypes[26], "TSC"); + strcpy (ctypes[27], "NCP"); + strcpy (ctypes[28], "GLS"); + strcpy (ctypes[29], "DSS"); + strcpy (ctypes[30], "PLT"); + strcpy (ctypes[31], "TNX"); + strcpy (ctypes[32], "ZPX"); + strcpy (ctypes[33], "TPV"); + + /* Initialize distortion types */ + strcpy (dtypes[1], "SIP"); + + if (!strncmp (ctype1, "LONG",4)) + strncpy (ctype1, "XLON",4); + + strncpy (wcs->ctype[0], ctype1, 8); + strncpy (wcs->c1type, ctype1, 8); + strncpy (wcs->ptype, ctype1, 8); + + /* Linear coordinates */ + if (!strncmp (ctype1,"LINEAR",6)) + wcs->prjcode = WCS_LIN; + + /* Pixel coordinates */ + else if (!strncmp (ctype1,"PIXEL",6)) + wcs->prjcode = WCS_PIX; + + /*Detector pixel coordinates */ + else if (strsrch (ctype1,"DET")) + wcs->prjcode = WCS_PIX; + + /* Set up right ascension, declination, latitude, or longitude */ + else if (ctype1[0] == 'R' || ctype1[0] == 'D' || + ctype1[0] == 'A' || ctype1[1] == 'L') { + wcs->c1type[0] = ctype1[0]; + wcs->c1type[1] = ctype1[1]; + if (ctype1[2] == '-') { + wcs->c1type[2] = 0; + iproj = 3; + } + else { + wcs->c1type[2] = ctype1[2]; + iproj = 4; + if (ctype1[3] == '-') { + wcs->c1type[3] = 0; + } + else { + wcs->c1type[3] = ctype1[3]; + wcs->c1type[4] = 0; + } + } + if (ctype1[iproj] == '-') iproj = iproj + 1; + if (ctype1[iproj] == '-') iproj = iproj + 1; + if (ctype1[iproj] == '-') iproj = iproj + 1; + if (ctype1[iproj] == '-') iproj = iproj + 1; + wcs->ptype[0] = ctype1[iproj]; + wcs->ptype[1] = ctype1[iproj+1]; + wcs->ptype[2] = ctype1[iproj+2]; + wcs->ptype[3] = 0; + sprintf (wcs->ctype[0],"%-4s%4s",wcs->c1type,wcs->ptype); + for (i = 0; i < 8; i++) + if (wcs->ctype[0][i] == ' ') wcs->ctype[0][i] = '-'; + + /* Find projection type */ + wcs->prjcode = 0; /* default type is linear */ + for (i = 1; i < nctype; i++) { + if (!strncmp(wcs->ptype, ctypes[i], 3)) + wcs->prjcode = i; + } + + /* Handle "obsolete" NCP projection (now WCSLIB should be OK) + if (wcs->prjcode == WCS_NCP) { + if (wcs->wcsproj == WCS_BEST) + wcs->wcsproj = WCS_OLD; + else if (wcs->wcsproj == WCS_ALT) + wcs->wcsproj = WCS_NEW; + } */ + + /* Work around bug in WCSLIB handling of CAR projection + else if (wcs->prjcode == WCS_CAR) { + if (wcs->wcsproj == WCS_BEST) + wcs->wcsproj = WCS_OLD; + else if (wcs->wcsproj == WCS_ALT) + wcs->wcsproj = WCS_NEW; + } */ + + /* Work around bug in WCSLIB handling of COE projection + else if (wcs->prjcode == WCS_COE) { + if (wcs->wcsproj == WCS_BEST) + wcs->wcsproj = WCS_OLD; + else if (wcs->wcsproj == WCS_ALT) + wcs->wcsproj = WCS_NEW; + } + + else if (wcs->wcsproj == WCS_BEST) */ + if (wcs->wcsproj == WCS_BEST) + wcs->wcsproj = WCS_NEW; + + else if (wcs->wcsproj == WCS_ALT) + wcs->wcsproj = WCS_OLD; + + /* if (wcs->wcsproj == WCS_OLD && ( + wcs->prjcode != WCS_STG && wcs->prjcode != WCS_AIT && + wcs->prjcode != WCS_MER && wcs->prjcode != WCS_GLS && + wcs->prjcode != WCS_ARC && wcs->prjcode != WCS_TAN && + wcs->prjcode != WCS_TNX && wcs->prjcode != WCS_SIN && + wcs->prjcode != WCS_PIX && wcs->prjcode != WCS_LIN && + wcs->prjcode != WCS_CAR && wcs->prjcode != WCS_COE && + wcs->prjcode != WCS_NCP && wcs->prjcode != WCS_ZPX)) + wcs->wcsproj = WCS_NEW; */ + + /* Handle NOAO corrected TNX as uncorrected TAN if oldwcs is set */ + if (wcs->wcsproj == WCS_OLD && wcs->prjcode == WCS_TNX) { + wcs->ctype[0][6] = 'A'; + wcs->ctype[0][7] = 'N'; + wcs->prjcode = WCS_TAN; + } + + /* Handle NOAO corrected ZPX as uncorrected ZPN if oldwcs is set */ + if (wcs->wcsproj == WCS_OLD && wcs->prjcode == WCS_ZPX) { + wcs->ctype[0][6] = 'P'; + wcs->ctype[0][7] = 'N'; + wcs->prjcode = WCS_ZPN; + } + } + + /* If not sky coordinates, assume linear */ + else { + wcs->prjcode = WCS_LIN; + return (0); + } + + /* Second coordinate type */ + if (!strncmp (ctype2, "NPOL",4)) { + ctype2[0] = ctype1[0]; + strncpy (ctype2+1, "LAT",3); + wcs->latbase = 90; + strcpy (wcs->radecsys,"NPOLE"); + wcs->syswcs = WCS_NPOLE; + } + else if (!strncmp (ctype2, "SPA-",4)) { + ctype2[0] = ctype1[0]; + strncpy (ctype2+1, "LAT",3); + wcs->latbase = -90; + strcpy (wcs->radecsys,"SPA"); + wcs->syswcs = WCS_SPA; + } + else + wcs->latbase = 0; + strncpy (wcs->ctype[1], ctype2, 8); + strncpy (wcs->c2type, ctype2, 8); + + /* Linear coordinates */ + if (!strncmp (ctype2,"LINEAR",6)) + wcs->prjcode = WCS_LIN; + + /* Pixel coordinates */ + else if (!strncmp (ctype2,"PIXEL",6)) + wcs->prjcode = WCS_PIX; + + /* Set up right ascension, declination, latitude, or longitude */ + else if (ctype2[0] == 'R' || ctype2[0] == 'D' || + ctype2[0] == 'A' || ctype2[1] == 'L') { + wcs->c2type[0] = ctype2[0]; + wcs->c2type[1] = ctype2[1]; + if (ctype2[2] == '-') { + wcs->c2type[2] = 0; + iproj = 3; + } + else { + wcs->c2type[2] = ctype2[2]; + iproj = 4; + if (ctype2[3] == '-') { + wcs->c2type[3] = 0; + } + else { + wcs->c2type[3] = ctype2[3]; + wcs->c2type[4] = 0; + } + } + if (ctype2[iproj] == '-') iproj = iproj + 1; + if (ctype2[iproj] == '-') iproj = iproj + 1; + if (ctype2[iproj] == '-') iproj = iproj + 1; + if (ctype2[iproj] == '-') iproj = iproj + 1; + wcs->ptype[0] = ctype2[iproj]; + wcs->ptype[1] = ctype2[iproj+1]; + wcs->ptype[2] = ctype2[iproj+2]; + wcs->ptype[3] = 0; + + if (!strncmp (ctype1, "DEC", 3) || + !strncmp (ctype1+1, "LAT", 3)) + wcs->coorflip = 1; + else + wcs->coorflip = 0; + if (ctype2[1] == 'L' || ctype2[0] == 'A') { + wcs->degout = 1; + wcs->ndec = 5; + } + else { + wcs->degout = 0; + wcs->ndec = 3; + } + sprintf (wcs->ctype[1],"%-4s%4s",wcs->c2type,wcs->ptype); + for (i = 0; i < 8; i++) + if (wcs->ctype[1][i] == ' ') wcs->ctype[1][i] = '-'; + } + + /* If not sky coordinates, assume linear */ + else { + wcs->prjcode = WCS_LIN; + } + + /* Set distortion code from CTYPE1 extension */ + setdistcode (wcs, ctype1); + + return (0); +} + + +int +wcsreset (wcs, crpix1, crpix2, crval1, crval2, cdelt1, cdelt2, crota, cd) + +struct WorldCoor *wcs; /* World coordinate system data structure */ +double crpix1, crpix2; /* Reference pixel coordinates */ +double crval1, crval2; /* Coordinates at reference pixel in degrees */ +double cdelt1, cdelt2; /* scale in degrees/pixel, ignored if cd is not NULL */ +double crota; /* Rotation angle in degrees, ignored if cd is not NULL */ +double *cd; /* Rotation matrix, used if not NULL */ +{ + + if (nowcs (wcs)) + return (-1); + + /* Set WCSLIB flags so that structures will be reinitialized */ + wcs->cel.flag = 0; + wcs->lin.flag = 0; + wcs->wcsl.flag = 0; + + /* Reference pixel coordinates and WCS value */ + wcs->crpix[0] = crpix1; + wcs->crpix[1] = crpix2; + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + wcs->lin.crpix = wcs->crpix; + + wcs->crval[0] = crval1; + wcs->crval[1] = crval2; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + if (wcs->coorflip) { + wcs->cel.ref[1] = wcs->crval[0]; + wcs->cel.ref[0] = wcs->crval[1]; + } + else { + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + } + /* Keep ref[2] and ref[3] from input */ + + /* Initialize to no plate fit */ + wcs->ncoeff1 = 0; + wcs->ncoeff2 = 0; + + if (cd != NULL) + wcscdset (wcs, cd); + + else if (cdelt1 != 0.0) + wcsdeltset (wcs, cdelt1, cdelt2, crota); + + else { + wcs->xinc = 1.0; + wcs->yinc = 1.0; + setwcserr ("WCSRESET: setting CDELT to 1"); + } + + /* Coordinate reference frame, equinox, and epoch */ + if (!strncmp (wcs->ptype,"LINEAR",6) || + !strncmp (wcs->ptype,"PIXEL",5)) + wcs->degout = -1; + + wcs->wcson = 1; + return (0); +} + +void +wcseqset (wcs, equinox) + +struct WorldCoor *wcs; /* World coordinate system data structure */ +double equinox; /* Desired equinox as fractional year */ +{ + + if (nowcs (wcs)) + return; + + /* Leave WCS alone if already at desired equinox */ + if (wcs->equinox == equinox) + return; + + /* Convert center from B1950 (FK4) to J2000 (FK5) */ + if (equinox == 2000.0 && wcs->equinox == 1950.0) { + if (wcs->coorflip) { + fk425e (&wcs->crval[1], &wcs->crval[0], wcs->epoch); + wcs->cel.ref[1] = wcs->crval[0]; + wcs->cel.ref[0] = wcs->crval[1]; + } + else { + fk425e (&wcs->crval[0], &wcs->crval[1], wcs->epoch); + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + } + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + wcs->equinox = 2000.0; + strcpy (wcs->radecsys, "FK5"); + wcs->syswcs = WCS_J2000; + wcs->cel.flag = 0; + wcs->wcsl.flag = 0; + } + + /* Convert center from J2000 (FK5) to B1950 (FK4) */ + else if (equinox == 1950.0 && wcs->equinox == 2000.0) { + if (wcs->coorflip) { + fk524e (&wcs->crval[1], &wcs->crval[0], wcs->epoch); + wcs->cel.ref[1] = wcs->crval[0]; + wcs->cel.ref[0] = wcs->crval[1]; + } + else { + fk524e (&wcs->crval[0], &wcs->crval[1], wcs->epoch); + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + } + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + wcs->equinox = 1950.0; + strcpy (wcs->radecsys, "FK4"); + wcs->syswcs = WCS_B1950; + wcs->cel.flag = 0; + wcs->wcsl.flag = 0; + } + wcsoutinit (wcs, wcs->radecsys); + wcsininit (wcs, wcs->radecsys); + return; +} + + +/* Set scale and rotation in WCS structure */ + +void +wcscdset (wcs, cd) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double *cd; /* CD matrix, ignored if NULL */ +{ + double tcd; + + if (cd == NULL) + return; + + wcs->rotmat = 1; + wcs->cd[0] = cd[0]; + wcs->cd[1] = cd[1]; + wcs->cd[2] = cd[2]; + wcs->cd[3] = cd[3]; + (void) matinv (2, wcs->cd, wcs->dc); + + /* Compute scale */ + wcs->xinc = sqrt (cd[0]*cd[0] + cd[2]*cd[2]); + wcs->yinc = sqrt (cd[1]*cd[1] + cd[3]*cd[3]); + + /* Deal with x=Dec/y=RA case */ + if (wcs->coorflip) { + tcd = cd[1]; + cd[1] = -cd[2]; + cd[2] = -tcd; + } + wcslibrot (wcs); + wcs->wcson = 1; + + /* Compute image rotation */ + wcsrotset (wcs); + + wcs->cdelt[0] = wcs->xinc; + wcs->cdelt[1] = wcs->yinc; + + return; +} + + +/* Set scale and rotation in WCS structure from axis scale and rotation */ + +void +wcsdeltset (wcs, cdelt1, cdelt2, crota) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double cdelt1; /* degrees/pixel in first axis (or both axes) */ +double cdelt2; /* degrees/pixel in second axis if nonzero */ +double crota; /* Rotation counterclockwise in degrees */ +{ + double *pci; + double crot, srot; + int i, j, naxes; + + naxes = wcs->naxis; + if (naxes > 2) + naxes = 2; + wcs->cdelt[0] = cdelt1; + if (cdelt2 != 0.0) + wcs->cdelt[1] = cdelt2; + else + wcs->cdelt[1] = cdelt1; + wcs->xinc = wcs->cdelt[0]; + wcs->yinc = wcs->cdelt[1]; + pci = wcs->pc; + for (i = 0; i < naxes; i++) { + for (j = 0; j < naxes; j++) { + if (i ==j) + *pci = 1.0; + else + *pci = 0.0; + pci++; + } + } + wcs->rotmat = 0; + + /* If image is reversed, value of CROTA is flipped, too */ + wcs->rot = crota; + if (wcs->rot < 0.0) + wcs->rot = wcs->rot + 360.0; + if (wcs->rot >= 360.0) + wcs->rot = wcs->rot - 360.0; + crot = cos (degrad(wcs->rot)); + if (cdelt1 * cdelt2 > 0) + srot = sin (-degrad(wcs->rot)); + else + srot = sin (degrad(wcs->rot)); + + /* Set CD matrix */ + wcs->cd[0] = wcs->cdelt[0] * crot; + if (wcs->cdelt[0] < 0) + wcs->cd[1] = -fabs (wcs->cdelt[1]) * srot; + else + wcs->cd[1] = fabs (wcs->cdelt[1]) * srot; + if (wcs->cdelt[1] < 0) + wcs->cd[2] = fabs (wcs->cdelt[0]) * srot; + else + wcs->cd[2] = -fabs (wcs->cdelt[0]) * srot; + wcs->cd[3] = wcs->cdelt[1] * crot; + (void) matinv (2, wcs->cd, wcs->dc); + + /* Set rotation matrix */ + wcslibrot (wcs); + + /* Set image rotation and mirroring */ + if (wcs->coorflip) { + if (wcs->cdelt[0] < 0 && wcs->cdelt[1] > 0) { + wcs->imflip = 1; + wcs->imrot = wcs->rot - 90.0; + if (wcs->imrot < -180.0) wcs->imrot = wcs->imrot + 360.0; + wcs->pa_north = wcs->rot; + wcs->pa_east = wcs->rot - 90.0; + if (wcs->pa_east < -180.0) wcs->pa_east = wcs->pa_east + 360.0; + } + else if (wcs->cdelt[0] > 0 && wcs->cdelt[1] < 0) { + wcs->imflip = 1; + wcs->imrot = wcs->rot + 90.0; + if (wcs->imrot > 180.0) wcs->imrot = wcs->imrot - 360.0; + wcs->pa_north = wcs->rot; + wcs->pa_east = wcs->rot - 90.0; + if (wcs->pa_east < -180.0) wcs->pa_east = wcs->pa_east + 360.0; + } + else if (wcs->cdelt[0] > 0 && wcs->cdelt[1] > 0) { + wcs->imflip = 0; + wcs->imrot = wcs->rot + 90.0; + if (wcs->imrot > 180.0) wcs->imrot = wcs->imrot - 360.0; + wcs->pa_north = wcs->imrot; + wcs->pa_east = wcs->rot + 90.0; + if (wcs->pa_east > 180.0) wcs->pa_east = wcs->pa_east - 360.0; + } + else if (wcs->cdelt[0] < 0 && wcs->cdelt[1] < 0) { + wcs->imflip = 0; + wcs->imrot = wcs->rot - 90.0; + if (wcs->imrot < -180.0) wcs->imrot = wcs->imrot + 360.0; + wcs->pa_north = wcs->imrot; + wcs->pa_east = wcs->rot + 90.0; + if (wcs->pa_east > 180.0) wcs->pa_east = wcs->pa_east - 360.0; + } + } + else { + if (wcs->cdelt[0] < 0 && wcs->cdelt[1] > 0) { + wcs->imflip = 0; + wcs->imrot = wcs->rot; + wcs->pa_north = wcs->rot + 90.0; + if (wcs->pa_north > 180.0) wcs->pa_north = wcs->pa_north - 360.0; + wcs->pa_east = wcs->rot + 180.0; + if (wcs->pa_east > 180.0) wcs->pa_east = wcs->pa_east - 360.0; + } + else if (wcs->cdelt[0] > 0 && wcs->cdelt[1] < 0) { + wcs->imflip = 0; + wcs->imrot = wcs->rot + 180.0; + if (wcs->imrot > 180.0) wcs->imrot = wcs->imrot - 360.0; + wcs->pa_north = wcs->imrot + 90.0; + if (wcs->pa_north > 180.0) wcs->pa_north = wcs->pa_north - 360.0; + wcs->pa_east = wcs->imrot + 180.0; + if (wcs->pa_east > 180.0) wcs->pa_east = wcs->pa_east - 360.0; + } + else if (wcs->cdelt[0] > 0 && wcs->cdelt[1] > 0) { + wcs->imflip = 1; + wcs->imrot = -wcs->rot; + wcs->pa_north = wcs->imrot + 90.0; + if (wcs->pa_north > 180.0) wcs->pa_north = wcs->pa_north - 360.0; + wcs->pa_east = wcs->rot; + } + else if (wcs->cdelt[0] < 0 && wcs->cdelt[1] < 0) { + wcs->imflip = 1; + wcs->imrot = wcs->rot + 180.0; + if (wcs->imrot > 180.0) wcs->imrot = wcs->imrot - 360.0; + wcs->pa_north = wcs->imrot + 90.0; + if (wcs->pa_north > 180.0) wcs->pa_north = wcs->pa_north - 360.0; + wcs->pa_east = wcs->rot + 90.0; + if (wcs->pa_east > 180.0) wcs->pa_east = wcs->pa_east - 360.0; + } + } + + return; +} + + +/* Set scale and rotation in WCS structure */ + +void +wcspcset (wcs, cdelt1, cdelt2, pc) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double cdelt1; /* degrees/pixel in first axis (or both axes) */ +double cdelt2; /* degrees/pixel in second axis if nonzero */ +double *pc; /* Rotation matrix, ignored if NULL */ +{ + double *pci, *pc0i; + int i, j, naxes; + + if (pc == NULL) + return; + + naxes = wcs->naxis; +/* if (naxes > 2) + naxes = 2; */ + if (naxes < 1 || naxes > 9) { + naxes = wcs->naxes; + wcs->naxis = naxes; + } + wcs->cdelt[0] = cdelt1; + if (cdelt2 != 0.0) + wcs->cdelt[1] = cdelt2; + else + wcs->cdelt[1] = cdelt1; + wcs->xinc = wcs->cdelt[0]; + wcs->yinc = wcs->cdelt[1]; + + /* Set rotation matrix */ + pci = wcs->pc; + pc0i = pc; + for (i = 0; i < naxes; i++) { + for (j = 0; j < naxes; j++) { + *pci = *pc0i; + pci++; + pc0i++; + } + } + + /* Set CD matrix */ + if (naxes > 1) { + wcs->cd[0] = pc[0] * wcs->cdelt[0]; + wcs->cd[1] = pc[1] * wcs->cdelt[0]; + wcs->cd[2] = pc[naxes] * wcs->cdelt[1]; + wcs->cd[3] = pc[naxes+1] * wcs->cdelt[1]; + } + else { + wcs->cd[0] = pc[0] * wcs->cdelt[0]; + wcs->cd[1] = 0.0; + wcs->cd[2] = 0.0; + wcs->cd[3] = 1.0; + } + (void) matinv (2, wcs->cd, wcs->dc); + wcs->rotmat = 1; + + (void)linset (&wcs->lin); + wcs->wcson = 1; + + wcsrotset (wcs); + + return; +} + + +/* Set up rotation matrix for WCSLIB projection subroutines */ + +static void +wcslibrot (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ + +{ + int i, mem, naxes; + + naxes = wcs->naxis; + if (naxes > 2) + naxes = 2; + if (naxes < 1 || naxes > 9) { + naxes = wcs->naxes; + wcs->naxis = naxes; + } + mem = naxes * naxes * sizeof(double); + if (wcs->lin.piximg == NULL) + wcs->lin.piximg = (double*)malloc(mem); + if (wcs->lin.piximg != NULL) { + if (wcs->lin.imgpix == NULL) + wcs->lin.imgpix = (double*)malloc(mem); + if (wcs->lin.imgpix != NULL) { + wcs->lin.flag = LINSET; + if (naxes == 2) { + for (i = 0; i < 4; i++) { + wcs->lin.piximg[i] = wcs->cd[i]; + } + } + else if (naxes == 3) { + for (i = 0; i < 9; i++) + wcs->lin.piximg[i] = 0.0; + wcs->lin.piximg[0] = wcs->cd[0]; + wcs->lin.piximg[1] = wcs->cd[1]; + wcs->lin.piximg[3] = wcs->cd[2]; + wcs->lin.piximg[4] = wcs->cd[3]; + wcs->lin.piximg[8] = 1.0; + } + else if (naxes == 4) { + for (i = 0; i < 16; i++) + wcs->lin.piximg[i] = 0.0; + wcs->lin.piximg[0] = wcs->cd[0]; + wcs->lin.piximg[1] = wcs->cd[1]; + wcs->lin.piximg[4] = wcs->cd[2]; + wcs->lin.piximg[5] = wcs->cd[3]; + wcs->lin.piximg[10] = 1.0; + wcs->lin.piximg[15] = 1.0; + } + (void) matinv (naxes, wcs->lin.piximg, wcs->lin.imgpix); + wcs->lin.crpix = wcs->crpix; + wcs->lin.cdelt = wcs->cdelt; + wcs->lin.pc = wcs->pc; + wcs->lin.flag = LINSET; + } + } + return; +} + + +/* Compute image rotation */ + +void +wcsrotset (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ +{ + int off; + double cra, cdec, xc, xn, xe, yc, yn, ye; + + /* If image is one-dimensional, leave rotation angle alone */ + if (wcs->nxpix < 1.5 || wcs->nypix < 1.5) { + wcs->imrot = wcs->rot; + wcs->pa_north = wcs->rot + 90.0; + wcs->pa_east = wcs->rot + 180.0; + return; + } + + + /* Do not try anything if image is LINEAR (not Cartesian projection) */ + if (wcs->syswcs == WCS_LINEAR) + return; + + wcs->xinc = fabs (wcs->xinc); + wcs->yinc = fabs (wcs->yinc); + + /* Compute position angles of North and East in image */ + xc = wcs->xrefpix; + yc = wcs->yrefpix; + pix2wcs (wcs, xc, yc, &cra, &cdec); + if (wcs->coorflip) { + wcs2pix (wcs, cra+wcs->yinc, cdec, &xe, &ye, &off); + wcs2pix (wcs, cra, cdec+wcs->xinc, &xn, &yn, &off); + } + else { + wcs2pix (wcs, cra+wcs->xinc, cdec, &xe, &ye, &off); + wcs2pix (wcs, cra, cdec+wcs->yinc, &xn, &yn, &off); + } + wcs->pa_north = raddeg (atan2 (yn-yc, xn-xc)); + if (wcs->pa_north < -90.0) + wcs->pa_north = wcs->pa_north + 360.0; + wcs->pa_east = raddeg (atan2 (ye-yc, xe-xc)); + if (wcs->pa_east < -90.0) + wcs->pa_east = wcs->pa_east + 360.0; + + /* Compute image rotation angle from North */ + if (wcs->pa_north < -90.0) + wcs->imrot = 270.0 + wcs->pa_north; + else + wcs->imrot = wcs->pa_north - 90.0; + + /* Compute CROTA */ + if (wcs->coorflip) { + wcs->rot = wcs->imrot + 90.0; + if (wcs->rot < 0.0) + wcs->rot = wcs->rot + 360.0; + } + else + wcs->rot = wcs->imrot; + if (wcs->rot < 0.0) + wcs->rot = wcs->rot + 360.0; + if (wcs->rot >= 360.0) + wcs->rot = wcs->rot - 360.0; + + /* Set image mirror flag based on axis orientation */ + wcs->imflip = 0; + if (wcs->pa_east - wcs->pa_north < -80.0 && + wcs->pa_east - wcs->pa_north > -100.0) + wcs->imflip = 1; + if (wcs->pa_east - wcs->pa_north < 280.0 && + wcs->pa_east - wcs->pa_north > 260.0) + wcs->imflip = 1; + if (wcs->pa_north - wcs->pa_east > 80.0 && + wcs->pa_north - wcs->pa_east < 100.0) + wcs->imflip = 1; + if (wcs->coorflip) { + if (wcs->imflip) + wcs->yinc = -wcs->yinc; + } + else { + if (!wcs->imflip) + wcs->xinc = -wcs->xinc; + } + + return; +} + + +/* Return 1 if WCS structure is filled, else 0 */ + +int +iswcs (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ + +{ + if (wcs == NULL) + return (0); + else + return (wcs->wcson); +} + + +/* Return 0 if WCS structure is filled, else 1 */ + +int +nowcs (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ + +{ + if (wcs == NULL) + return (1); + else + return (!wcs->wcson); +} + + +/* Reset the center of a WCS structure */ + +void +wcsshift (wcs,rra,rdec,coorsys) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double rra; /* Reference pixel right ascension in degrees */ +double rdec; /* Reference pixel declination in degrees */ +char *coorsys; /* FK4 or FK5 coordinates (1950 or 2000) */ + +{ + if (nowcs (wcs)) + return; + +/* Approximate world coordinate system from a known plate scale */ + wcs->crval[0] = rra; + wcs->crval[1] = rdec; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + + +/* Coordinate reference frame */ + strcpy (wcs->radecsys,coorsys); + wcs->syswcs = wcscsys (coorsys); + if (wcs->syswcs == WCS_B1950) + wcs->equinox = 1950.0; + else + wcs->equinox = 2000.0; + + return; +} + +/* Print position of WCS center, if WCS is set */ + +void +wcscent (wcs) + +struct WorldCoor *wcs; /* World coordinate system structure */ + +{ + double xpix,ypix, xpos1, xpos2, ypos1, ypos2; + char wcstring[32]; + double width, height, secpix, secpixh, secpixw; + int lstr = 32; + + if (nowcs (wcs)) + (void)fprintf (stderr,"No WCS information available\n"); + else { + if (wcs->prjcode == WCS_DSS) + (void)fprintf (stderr,"WCS plate center %s\n", wcs->center); + xpix = 0.5 * wcs->nxpix; + ypix = 0.5 * wcs->nypix; + (void) pix2wcst (wcs,xpix,ypix,wcstring, lstr); + (void)fprintf (stderr,"WCS center %s %s %s %s at pixel (%.2f,%.2f)\n", + wcs->ctype[0],wcs->ctype[1],wcstring,wcs->ptype,xpix,ypix); + + /* Image width */ + (void) pix2wcs (wcs,1.0,ypix,&xpos1,&ypos1); + (void) pix2wcs (wcs,wcs->nxpix,ypix,&xpos2,&ypos2); + if (wcs->syswcs == WCS_LINEAR) { + width = xpos2 - xpos1; + if (width < 100.0) + (void)fprintf (stderr, "WCS width = %.5f %s ",width, wcs->units[0]); + else + (void)fprintf (stderr, "WCS width = %.3f %s ",width, wcs->units[0]); + } + else { + width = wcsdist (xpos1,ypos1,xpos2,ypos2); + if (width < 1/60.0) + (void)fprintf (stderr, "WCS width = %.2f arcsec ",width*3600.0); + else if (width < 1.0) + (void)fprintf (stderr, "WCS width = %.2f arcmin ",width*60.0); + else + (void)fprintf (stderr, "WCS width = %.3f degrees ",width); + } + secpixw = width / (wcs->nxpix - 1.0); + + /* Image height */ + (void) pix2wcs (wcs,xpix,1.0,&xpos1,&ypos1); + (void) pix2wcs (wcs,xpix,wcs->nypix,&xpos2,&ypos2); + if (wcs->syswcs == WCS_LINEAR) { + height = ypos2 - ypos1; + if (height < 100.0) + (void)fprintf (stderr, " height = %.5f %s ",height, wcs->units[1]); + else + (void)fprintf (stderr, " height = %.3f %s ",height, wcs->units[1]); + } + else { + height = wcsdist (xpos1,ypos1,xpos2,ypos2); + if (height < 1/60.0) + (void) fprintf (stderr, " height = %.2f arcsec",height*3600.0); + else if (height < 1.0) + (void) fprintf (stderr, " height = %.2f arcmin",height*60.0); + else + (void) fprintf (stderr, " height = %.3f degrees",height); + } + secpixh = height / (wcs->nypix - 1.0); + + /* Image scale */ + if (wcs->syswcs == WCS_LINEAR) { + (void) fprintf (stderr,"\n"); + (void) fprintf (stderr,"WCS %.5f %s/pixel, %.5f %s/pixel\n", + wcs->xinc,wcs->units[0],wcs->yinc,wcs->units[1]); + } + else { + if (wcs->xinc != 0.0 && wcs->yinc != 0.0) + secpix = (fabs(wcs->xinc) + fabs(wcs->yinc)) * 0.5 * 3600.0; + else if (secpixh > 0.0 && secpixw > 0.0) + secpix = (secpixw + secpixh) * 0.5 * 3600.0; + else if (wcs->xinc != 0.0 || wcs->yinc != 0.0) + secpix = (fabs(wcs->xinc) + fabs(wcs->yinc)) * 3600.0; + else + secpix = (secpixw + secpixh) * 3600.0; + if (secpix < 100.0) + (void) fprintf (stderr, " %.3f arcsec/pixel\n",secpix); + else if (secpix < 3600.0) + (void) fprintf (stderr, " %.3f arcmin/pixel\n",secpix/60.0); + else + (void) fprintf (stderr, " %.3f degrees/pixel\n",secpix/3600.0); + } + } + return; +} + +/* Return RA and Dec of image center, plus size in RA and Dec */ + +void +wcssize (wcs, cra, cdec, dra, ddec) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double *cra; /* Right ascension of image center (deg) (returned) */ +double *cdec; /* Declination of image center (deg) (returned) */ +double *dra; /* Half-width in right ascension (deg) (returned) */ +double *ddec; /* Half-width in declination (deg) (returned) */ + +{ + double width, height; + + /* Find right ascension and declination of coordinates */ + if (iswcs(wcs)) { + wcsfull (wcs, cra, cdec, &width, &height); + *dra = 0.5 * width / cos (degrad (*cdec)); + *ddec = 0.5 * height; + } + else { + *cra = 0.0; + *cdec = 0.0; + *dra = 0.0; + *ddec = 0.0; + } + return; +} + + +/* Return RA and Dec of image center, plus size in degrees */ + +void +wcsfull (wcs, cra, cdec, width, height) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double *cra; /* Right ascension of image center (deg) (returned) */ +double *cdec; /* Declination of image center (deg) (returned) */ +double *width; /* Width in degrees (returned) */ +double *height; /* Height in degrees (returned) */ + +{ + double xpix, ypix, xpos1, xpos2, ypos1, ypos2, xcpix, ycpix; + double xcent, ycent; + + /* Find right ascension and declination of coordinates */ + if (iswcs(wcs)) { + xcpix = (0.5 * wcs->nxpix) + 0.5; + ycpix = (0.5 * wcs->nypix) + 0.5; + (void) pix2wcs (wcs,xcpix,ycpix,&xcent, &ycent); + *cra = xcent; + *cdec = ycent; + + /* Compute image width in degrees */ + xpix = 0.500001; + (void) pix2wcs (wcs,xpix,ycpix,&xpos1,&ypos1); + xpix = wcs->nxpix + 0.499999; + (void) pix2wcs (wcs,xpix,ycpix,&xpos2,&ypos2); + if (strncmp (wcs->ptype,"LINEAR",6) && + strncmp (wcs->ptype,"PIXEL",5)) { + *width = wcsdist (xpos1,ypos1,xpos2,ypos2); + } + else + *width = sqrt (((ypos2-ypos1) * (ypos2-ypos1)) + + ((xpos2-xpos1) * (xpos2-xpos1))); + + /* Compute image height in degrees */ + ypix = 0.5; + (void) pix2wcs (wcs,xcpix,ypix,&xpos1,&ypos1); + ypix = wcs->nypix + 0.5; + (void) pix2wcs (wcs,xcpix,ypix,&xpos2,&ypos2); + if (strncmp (wcs->ptype,"LINEAR",6) && + strncmp (wcs->ptype,"PIXEL",5)) + *height = wcsdist (xpos1,ypos1,xpos2,ypos2); + else + *height = sqrt (((ypos2-ypos1) * (ypos2-ypos1)) + + ((xpos2-xpos1) * (xpos2-xpos1))); + } + + else { + *cra = 0.0; + *cdec = 0.0; + *width = 0.0; + *height = 0.0; + } + + return; +} + + +/* Return minimum and maximum RA and Dec of image in degrees */ + +void +wcsrange (wcs, ra1, ra2, dec1, dec2) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double *ra1; /* Minimum right ascension of image (deg) (returned) */ +double *ra2; /* Maximum right ascension of image (deg) (returned) */ +double *dec1; /* Minimum declination of image (deg) (returned) */ +double *dec2; /* Maximum declination of image (deg) (returned) */ + +{ + double xpos1, xpos2, xpos3, xpos4, ypos1, ypos2, ypos3, ypos4, temp; + + if (iswcs(wcs)) { + + /* Compute image corner coordinates in degrees */ + (void) pix2wcs (wcs,1.0,1.0,&xpos1,&ypos1); + (void) pix2wcs (wcs,1.0,wcs->nypix,&xpos2,&ypos2); + (void) pix2wcs (wcs,wcs->nxpix,1.0,&xpos3,&ypos3); + (void) pix2wcs (wcs,wcs->nxpix,wcs->nypix,&xpos4,&ypos4); + + /* Find minimum right ascension or longitude */ + *ra1 = xpos1; + if (xpos2 < *ra1) *ra1 = xpos2; + if (xpos3 < *ra1) *ra1 = xpos3; + if (xpos4 < *ra1) *ra1 = xpos4; + + /* Find maximum right ascension or longitude */ + *ra2 = xpos1; + if (xpos2 > *ra2) *ra2 = xpos2; + if (xpos3 > *ra2) *ra2 = xpos3; + if (xpos4 > *ra2) *ra2 = xpos4; + + if (wcs->syswcs != WCS_LINEAR && wcs->syswcs != WCS_XY) { + if (*ra2 - *ra1 > 180.0) { + temp = *ra1; + *ra1 = *ra2; + *ra2 = temp; + } + } + + /* Find minimum declination or latitude */ + *dec1 = ypos1; + if (ypos2 < *dec1) *dec1 = ypos2; + if (ypos3 < *dec1) *dec1 = ypos3; + if (ypos4 < *dec1) *dec1 = ypos4; + + /* Find maximum declination or latitude */ + *dec2 = ypos1; + if (ypos2 > *dec2) *dec2 = ypos2; + if (ypos3 > *dec2) *dec2 = ypos3; + if (ypos4 > *dec2) *dec2 = ypos4; + } + + else { + *ra1 = 0.0; + *ra2 = 0.0; + *dec1 = 0.0; + *dec2 = 0.0; + } + + return; +} + + +/* Compute distance in degrees between two sky coordinates */ + +double +wcsdist (x1,y1,x2,y2) + +double x1,y1; /* (RA,Dec) or (Long,Lat) in degrees */ +double x2,y2; /* (RA,Dec) or (Long,Lat) in degrees */ + +{ + double r, diffi; + double pos1[3], pos2[3], w, diff; + int i; + + /* Convert two vectors to direction cosines */ + r = 1.0; + d2v3 (x1, y1, r, pos1); + d2v3 (x2, y2, r, pos2); + + /* Modulus squared of half the difference vector */ + w = 0.0; + for (i = 0; i < 3; i++) { + diffi = pos1[i] - pos2[i]; + w = w + (diffi * diffi); + } + w = w / 4.0; + if (w > 1.0) w = 1.0; + + /* Angle beween the vectors */ + diff = 2.0 * atan2 (sqrt (w), sqrt (1.0 - w)); + diff = raddeg (diff); + return (diff); +} + + + +/* Compute distance in degrees between two sky coordinates */ + +double +wcsdist1 (x1,y1,x2,y2) + +double x1,y1; /* (RA,Dec) or (Long,Lat) in degrees */ +double x2,y2; /* (RA,Dec) or (Long,Lat) in degrees */ + +{ + double d1, d2, r; + double pos1[3], pos2[3], w, diff; + int i; + + /* Convert two vectors to direction cosines */ + r = 1.0; + d2v3 (x1, y1, r, pos1); + d2v3 (x2, y2, r, pos2); + + w = 0.0; + d1 = 0.0; + d2 = 0.0; + for (i = 0; i < 3; i++) { + w = w + (pos1[i] * pos2[i]); + d1 = d1 + (pos1[i] * pos1[i]); + d2 = d2 + (pos2[i] * pos2[i]); + } + diff = acosdeg (w / (sqrt (d1) * sqrt (d2))); + return (diff); +} + + +/* Compute distance in degrees between two sky coordinates away from pole */ + +double +wcsdiff (x1,y1,x2,y2) + +double x1,y1; /* (RA,Dec) or (Long,Lat) in degrees */ +double x2,y2; /* (RA,Dec) or (Long,Lat) in degrees */ + +{ + double xdiff, ydiff, ycos, diff; + + ycos = cos (degrad ((y2 + y1) / 2.0)); + xdiff = x2 - x1; + if (xdiff > 180.0) + xdiff = xdiff - 360.0; + if (xdiff < -180.0) + xdiff = xdiff + 360.0; + xdiff = xdiff / ycos; + ydiff = (y2 - y1); + diff = sqrt ((xdiff * xdiff) + (ydiff * ydiff)); + return (diff); +} + + +/* Initialize catalog search command set by -wcscom */ + +void +wcscominit (wcs, i, command) + +struct WorldCoor *wcs; /* World coordinate system structure */ +int i; /* Number of command (0-9) to initialize */ +char *command; /* command with %s where coordinates will go */ + +{ + int lcom,icom; + + if (iswcs(wcs)) { + lcom = strlen (command); + if (lcom > 0) { + if (wcs->command_format[i] != NULL) + free (wcs->command_format[i]); + wcs->command_format[i] = (char *) calloc (lcom+2, 1); + if (wcs->command_format[i] == NULL) + return; + for (icom = 0; icom < lcom; icom++) { + if (command[icom] == '_') + wcs->command_format[i][icom] = ' '; + else + wcs->command_format[i][icom] = command[icom]; + } + wcs->command_format[i][lcom] = 0; + } + } + return; +} + + +/* Execute Unix command with world coordinates (from x,y) and/or filename */ + +void +wcscom ( wcs, i, filename, xfile, yfile, wcstring ) + +struct WorldCoor *wcs; /* World coordinate system structure */ +int i; /* Number of command (0-9) to execute */ +char *filename; /* Image file name */ +double xfile,yfile; /* Image pixel coordinates for WCS command */ +char *wcstring; /* WCS String from pix2wcst() */ +{ + char command[120]; + char comform[120]; + char xystring[32]; + char *fileform, *posform, *imform; + int ier; + + if (nowcs (wcs)) { + (void)fprintf(stderr,"WCSCOM: no WCS\n"); + return; + } + + if (wcs->command_format[i] != NULL) + strcpy (comform, wcs->command_format[i]); + else + strcpy (comform, "sgsc -ah %s"); + + if (comform[0] > 0) { + + /* Create and execute search command */ + fileform = strsrch (comform,"%f"); + imform = strsrch (comform,"%x"); + posform = strsrch (comform,"%s"); + if (imform != NULL) { + *(imform+1) = 's'; + (void)sprintf (xystring, "%.2f %.2f", xfile, yfile); + if (fileform != NULL) { + *(fileform+1) = 's'; + if (posform == NULL) { + if (imform < fileform) + (void)sprintf(command, comform, xystring, filename); + else + (void)sprintf(command, comform, filename, xystring); + } + else if (fileform < posform) { + if (imform < fileform) + (void)sprintf(command, comform, xystring, filename, + wcstring); + else if (imform < posform) + (void)sprintf(command, comform, filename, xystring, + wcstring); + else + (void)sprintf(command, comform, filename, wcstring, + xystring); + } + else + if (imform < posform) + (void)sprintf(command, comform, xystring, wcstring, + filename); + else if (imform < fileform) + (void)sprintf(command, comform, wcstring, xystring, + filename); + else + (void)sprintf(command, comform, wcstring, filename, + xystring); + } + else if (posform == NULL) + (void)sprintf(command, comform, xystring); + else if (imform < posform) + (void)sprintf(command, comform, xystring, wcstring); + else + (void)sprintf(command, comform, wcstring, xystring); + } + else if (fileform != NULL) { + *(fileform+1) = 's'; + if (posform == NULL) + (void)sprintf(command, comform, filename); + else if (fileform < posform) + (void)sprintf(command, comform, filename, wcstring); + else + (void)sprintf(command, comform, wcstring, filename); + } + else + (void)sprintf(command, comform, wcstring); + ier = system (command); + if (ier) + (void)fprintf(stderr,"WCSCOM: %s failed %d\n",command,ier); + } + return; +} + +/* Initialize WCS output coordinate system for use by PIX2WCS() */ + +void +wcsoutinit (wcs, coorsys) + +struct WorldCoor *wcs; /* World coordinate system structure */ +char *coorsys; /* Input world coordinate system: + FK4, FK5, B1950, J2000, GALACTIC, ECLIPTIC + fk4, fk5, b1950, j2000, galactic, ecliptic */ +{ + int sysout, i; + + if (nowcs (wcs)) + return; + + /* If argument is null, set to image system and equinox */ + if (coorsys == NULL || strlen (coorsys) < 1 || + !strcmp(coorsys,"IMSYS") || !strcmp(coorsys,"imsys")) { + sysout = wcs->syswcs; + strcpy (wcs->radecout, wcs->radecsys); + wcs->eqout = wcs->equinox; + if (sysout == WCS_B1950) { + if (wcs->eqout != 1950.0) { + wcs->radecout[0] = 'B'; + sprintf (wcs->radecout+1,"%.4f", wcs->equinox); + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + } + else + strcpy (wcs->radecout, "B1950"); + } + else if (sysout == WCS_J2000) { + if (wcs->eqout != 2000.0) { + wcs->radecout[0] = 'J'; + sprintf (wcs->radecout+1,"%.4f", wcs->equinox); + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + i = strlen(wcs->radecout) - 1; + if (wcs->radecout[i] == '0') + wcs->radecout[i] = (char)0; + } + else + strcpy (wcs->radecout, "J2000"); + } + } + + /* Ignore new coordinate system if it is not supported */ + else { + if ((sysout = wcscsys (coorsys)) < 0) + return; + + /* Do not try to convert linear or alt-az coordinates */ + if (sysout != wcs->syswcs && + (wcs->syswcs == WCS_LINEAR || wcs->syswcs == WCS_ALTAZ)) + return; + + strcpy (wcs->radecout, coorsys); + wcs->eqout = wcsceq (coorsys); + } + + wcs->sysout = sysout; + if (wcs->wcson) { + + /* Set output in degrees flag and number of decimal places */ + if (wcs->sysout == WCS_GALACTIC || wcs->sysout == WCS_ECLIPTIC || + wcs->sysout == WCS_PLANET) { + wcs->degout = 1; + wcs->ndec = 5; + } + else if (wcs->sysout == WCS_ALTAZ) { + wcs->degout = 1; + wcs->ndec = 5; + } + else if (wcs->sysout == WCS_NPOLE || wcs->sysout == WCS_SPA) { + wcs->degout = 1; + wcs->ndec = 5; + } + else { + wcs->degout = 0; + wcs->ndec = 3; + } + } + return; +} + + +/* Return current value of WCS output coordinate system set by -wcsout */ +char * +getwcsout(wcs) +struct WorldCoor *wcs; /* World coordinate system structure */ +{ + if (nowcs (wcs)) + return (NULL); + else + return(wcs->radecout); +} + + +/* Initialize WCS input coordinate system for use by WCS2PIX() */ + +void +wcsininit (wcs, coorsys) + +struct WorldCoor *wcs; /* World coordinate system structure */ +char *coorsys; /* Input world coordinate system: + FK4, FK5, B1950, J2000, GALACTIC, ECLIPTIC + fk4, fk5, b1950, j2000, galactic, ecliptic */ +{ + int sysin, i; + + if (nowcs (wcs)) + return; + + /* If argument is null, set to image system and equinox */ + if (coorsys == NULL || strlen (coorsys) < 1) { + wcs->sysin = wcs->syswcs; + strcpy (wcs->radecin, wcs->radecsys); + wcs->eqin = wcs->equinox; + if (wcs->sysin == WCS_B1950) { + if (wcs->eqin != 1950.0) { + wcs->radecin[0] = 'B'; + sprintf (wcs->radecin+1,"%.4f", wcs->equinox); + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + } + else + strcpy (wcs->radecin, "B1950"); + } + else if (wcs->sysin == WCS_J2000) { + if (wcs->eqin != 2000.0) { + wcs->radecin[0] = 'J'; + sprintf (wcs->radecin+1,"%.4f", wcs->equinox); + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + i = strlen(wcs->radecin) - 1; + if (wcs->radecin[i] == '0') + wcs->radecin[i] = (char)0; + } + else + strcpy (wcs->radecin, "J2000"); + } + } + + /* Ignore new coordinate system if it is not supported */ + if ((sysin = wcscsys (coorsys)) < 0) + return; + + wcs->sysin = sysin; + wcs->eqin = wcsceq (coorsys); + strcpy (wcs->radecin, coorsys); + return; +} + + +/* Return current value of WCS input coordinate system set by wcsininit */ +char * +getwcsin (wcs) +struct WorldCoor *wcs; /* World coordinate system structure */ +{ + if (nowcs (wcs)) + return (NULL); + else + return (wcs->radecin); +} + + +/* Set WCS output in degrees or hh:mm:ss dd:mm:ss, returning old flag value */ +int +setwcsdeg(wcs, new) +struct WorldCoor *wcs; /* World coordinate system structure */ +int new; /* 1: degrees, 0: h:m:s d:m:s */ +{ + int old; + + if (nowcs (wcs)) + return (0); + old = wcs->degout; + wcs->degout = new; + if (new == 1 && old == 0 && wcs->ndec == 3) + wcs->ndec = 6; + if (new == 0 && old == 1 && wcs->ndec == 5) + wcs->ndec = 3; + return(old); +} + + +/* Set number of decimal places in pix2wcst output string */ +int +wcsndec (wcs, ndec) +struct WorldCoor *wcs; /* World coordinate system structure */ +int ndec; /* Number of decimal places in output string */ + /* If < 0, return current unchanged value */ +{ + if (nowcs (wcs)) + return (0); + else if (ndec >= 0) + wcs->ndec = ndec; + return (wcs->ndec); +} + + + +/* Return current value of coordinate system */ +char * +getradecsys(wcs) +struct WorldCoor *wcs; /* World coordinate system structure */ +{ + if (nowcs (wcs)) + return (NULL); + else + return (wcs->radecsys); +} + + +/* Set output string mode for LINEAR coordinates */ + +void +setwcslin (wcs, mode) +struct WorldCoor *wcs; /* World coordinate system structure */ +int mode; /* mode = 0: x y linear + mode = 1: x units x units + mode = 2: x y linear units */ +{ + if (iswcs (wcs)) + wcs->linmode = mode; + return; +} + + +/* Convert pixel coordinates to World Coordinate string */ + +int +pix2wcst (wcs, xpix, ypix, wcstring, lstr) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double xpix,ypix; /* Image coordinates in pixels */ +char *wcstring; /* World coordinate string (returned) */ +int lstr; /* Length of world coordinate string (returned) */ +{ + double xpos,ypos; + char rastr[32], decstr[32]; + int minlength, lunits, lstring; + + if (nowcs (wcs)) { + if (lstr > 0) + wcstring[0] = 0; + return(0); + } + + pix2wcs (wcs,xpix,ypix,&xpos,&ypos); + + /* If point is off scale, set string accordingly */ + if (wcs->offscl) { + (void)sprintf (wcstring,"Off map"); + return (1); + } + + /* Print coordinates in degrees */ + else if (wcs->degout == 1) { + minlength = 9 + (2 * wcs->ndec); + if (lstr > minlength) { + deg2str (rastr, 32, xpos, wcs->ndec); + deg2str (decstr, 32, ypos, wcs->ndec); + if (wcs->tabsys) + (void)sprintf (wcstring,"%s %s", rastr, decstr); + else + (void)sprintf (wcstring,"%s %s", rastr, decstr); + lstr = lstr - minlength; + } + else { + if (wcs->tabsys) + strncpy (wcstring,"********* **********",lstr); + else + strncpy (wcstring,"*******************",lstr); + lstr = 0; + } + } + + /* print coordinates in sexagesimal notation */ + else if (wcs->degout == 0) { + minlength = 18 + (2 * wcs->ndec); + if (lstr > minlength) { + if (wcs->sysout == WCS_J2000 || wcs->sysout == WCS_B1950) { + ra2str (rastr, 32, xpos, wcs->ndec); + dec2str (decstr, 32, ypos, wcs->ndec-1); + } + else { + dec2str (rastr, 32, xpos, wcs->ndec); + dec2str (decstr, 32, ypos, wcs->ndec); + } + if (wcs->tabsys) { + (void)sprintf (wcstring,"%s %s", rastr, decstr); + } + else { + (void)sprintf (wcstring,"%s %s", rastr, decstr); + } + lstr = lstr - minlength; + } + else { + if (wcs->tabsys) { + strncpy (wcstring,"************* *************",lstr); + } + else { + strncpy (wcstring,"**************************",lstr); + } + lstr = 0; + } + } + + /* Label galactic coordinates */ + if (wcs->sysout == WCS_GALACTIC) { + if (lstr > 9 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," galactic"); + else + strcat (wcstring," galactic"); + } + } + + /* Label ecliptic coordinates */ + else if (wcs->sysout == WCS_ECLIPTIC) { + if (lstr > 9 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," ecliptic"); + else + strcat (wcstring," ecliptic"); + } + } + + /* Label planet coordinates */ + else if (wcs->sysout == WCS_PLANET) { + if (lstr > 9 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," planet"); + else + strcat (wcstring," planet"); + } + } + + /* Label alt-az coordinates */ + else if (wcs->sysout == WCS_ALTAZ) { + if (lstr > 7 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," alt-az"); + else + strcat (wcstring," alt-az"); + } + } + + /* Label north pole angle coordinates */ + else if (wcs->sysout == WCS_NPOLE) { + if (lstr > 7 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," long-npa"); + else + strcat (wcstring," long-npa"); + } + } + + /* Label south pole angle coordinates */ + else if (wcs->sysout == WCS_SPA) { + if (lstr > 7 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," long-spa"); + else + strcat (wcstring," long-spa"); + } + } + + /* Label equatorial coordinates */ + else if (wcs->sysout==WCS_B1950 || wcs->sysout==WCS_J2000) { + if (lstr > (int) strlen(wcs->radecout)+1 && wcs->printsys) { + if (wcs->tabsys) + strcat (wcstring," "); + else + strcat (wcstring," "); + strcat (wcstring, wcs->radecout); + } + } + + /* Output linear coordinates */ + else { + num2str (rastr, xpos, 0, wcs->ndec); + num2str (decstr, ypos, 0, wcs->ndec); + lstring = strlen (rastr) + strlen (decstr) + 1; + lunits = strlen (wcs->units[0]) + strlen (wcs->units[1]) + 2; + if (wcs->syswcs == WCS_LINEAR && wcs->linmode == 1) { + if (lstr > lstring + lunits) { + if (strlen (wcs->units[0]) > 0) { + strcat (rastr, " "); + strcat (rastr, wcs->units[0]); + } + if (strlen (wcs->units[1]) > 0) { + strcat (decstr, " "); + strcat (decstr, wcs->units[1]); + } + lstring = lstring + lunits; + } + } + if (lstr > lstring) { + if (wcs->tabsys) + (void)sprintf (wcstring,"%s %s", rastr, decstr); + else + (void)sprintf (wcstring,"%s %s", rastr, decstr); + } + else { + if (wcs->tabsys) + strncpy (wcstring,"********** *********",lstr); + else + strncpy (wcstring,"*******************",lstr); + } + if (wcs->syswcs == WCS_LINEAR && wcs->linmode != 1 && + lstr > lstring + 7) + strcat (wcstring, " linear"); + if (wcs->syswcs == WCS_LINEAR && wcs->linmode == 2 && + lstr > lstring + lunits + 7) { + if (strlen (wcs->units[0]) > 0) { + strcat (wcstring, " "); + strcat (wcstring, wcs->units[0]); + } + if (strlen (wcs->units[1]) > 0) { + strcat (wcstring, " "); + strcat (wcstring, wcs->units[1]); + } + + } + } + return (1); +} + + +/* Convert pixel coordinates to World Coordinates */ + +void +pix2wcs (wcs,xpix,ypix,xpos,ypos) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double xpix,ypix; /* x and y image coordinates in pixels */ +double *xpos,*ypos; /* RA and Dec in degrees (returned) */ +{ + double xpi, ypi, xp, yp; + double eqin, eqout; + int wcspos(); + + if (nowcs (wcs)) + return; + wcs->xpix = xpix; + wcs->ypix = ypix; + wcs->zpix = zpix; + wcs->offscl = 0; + + /* If this WCS is converted from another WCS rather than pixels, convert now */ + if (wcs->wcs != NULL) { + pix2wcs (wcs->wcs, xpix, ypix, &xpi, &ypi); + } + else { + pix2foc (wcs, xpix, ypix, &xpi, &ypi); + } + + /* Convert image coordinates to sky coordinates */ + + /* Use Digitized Sky Survey plate fit */ + if (wcs->prjcode == WCS_DSS) { + if (dsspos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + } + + /* Use SAO plate fit */ + else if (wcs->prjcode == WCS_PLT) { + if (platepos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + } + + /* Use NOAO IRAF corrected plane tangent projection */ + else if (wcs->prjcode == WCS_TNX) { + if (tnxpos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + } + + /* Use NOAO IRAF corrected zenithal projection */ + else if (wcs->prjcode == WCS_ZPX) { + if (zpxpos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + } + + /* Use Classic AIPS projections */ + else if (wcs->wcsproj == WCS_OLD || wcs->prjcode <= 0) { + if (worldpos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + } + + /* Use Mark Calabretta's WCSLIB projections */ + else if (wcspos (xpi, ypi, wcs, &xp, &yp)) + wcs->offscl = 1; + + + /* Do not change coordinates if offscale */ + if (wcs->offscl) { + *xpos = 0.0; + *ypos = 0.0; + } + else { + + /* Convert coordinates to output system, if not LINEAR */ + if (wcs->prjcode > 0) { + + /* Convert coordinates to desired output system */ + eqin = wcs->equinox; + eqout = wcs->eqout; + wcscon (wcs->syswcs,wcs->sysout,eqin,eqout,&xp,&yp,wcs->epoch); + } + if (wcs->latbase == 90) + yp = 90.0 - yp; + else if (wcs->latbase == -90) + yp = yp - 90.0; + wcs->xpos = xp; + wcs->ypos = yp; + *xpos = xp; + *ypos = yp; + } + + /* Keep RA/longitude within range if spherical coordinate output + (Not LINEAR or XY) */ + if (wcs->sysout > 0 && wcs->sysout != 6 && wcs->sysout != 10) { + if (*xpos < 0.0) + *xpos = *xpos + 360.0; + else if (*xpos > 360.0) + *xpos = *xpos - 360.0; + } + + return; +} + + +/* Convert World Coordinates to pixel coordinates */ + +void +wcs2pix (wcs, xpos, ypos, xpix, ypix, offscl) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double xpos,ypos; /* World coordinates in degrees */ +double *xpix,*ypix; /* Image coordinates in pixels */ +int *offscl; /* 0 if within bounds, else off scale */ +{ + wcsc2pix (wcs, xpos, ypos, wcs->radecin, xpix, ypix, offscl); + return; +} + +/* Convert World Coordinates to pixel coordinates */ + +void +wcsc2pix (wcs, xpos, ypos, coorsys, xpix, ypix, offscl) + +struct WorldCoor *wcs; /* World coordinate system structure */ +double xpos,ypos; /* World coordinates in degrees */ +char *coorsys; /* Input world coordinate system: + FK4, FK5, B1950, J2000, GALACTIC, ECLIPTIC + fk4, fk5, b1950, j2000, galactic, ecliptic + * If NULL, use image WCS */ +double *xpix,*ypix; /* Image coordinates in pixels */ +int *offscl; /* 0 if within bounds, else off scale */ +{ + double xp, yp, xpi, ypi; + double eqin, eqout; + int sysin; + int wcspix(); + + if (nowcs (wcs)) + return; + + *offscl = 0; + xp = xpos; + yp = ypos; + if (wcs->latbase == 90) + yp = 90.0 - yp; + else if (wcs->latbase == -90) + yp = yp - 90.0; + if (coorsys == NULL) { + sysin = wcs->syswcs; + eqin = wcs->equinox; + } + else { + sysin = wcscsys (coorsys); + eqin = wcsceq (coorsys); + } + wcs->zpix = 1.0; + + /* Convert coordinates to same system as image */ + if (sysin > 0 && sysin != 6 && sysin != 10) { + eqout = wcs->equinox; + wcscon (sysin, wcs->syswcs, eqin, eqout, &xp, &yp, wcs->epoch); + } + + /* Convert sky coordinates to image coordinates */ + + /* Use Digitized Sky Survey plate fit */ + if (wcs->prjcode == WCS_DSS) { + if (dsspix (xp, yp, wcs, &xpi, &ypi)) + *offscl = 1; + } + + /* Use SAO polynomial plate fit */ + else if (wcs->prjcode == WCS_PLT) { + if (platepix (xp, yp, wcs, &xpi, &ypi)) + *offscl = 1; + } + + /* Use NOAO IRAF corrected plane tangent projection */ + else if (wcs->prjcode == WCS_TNX) { + if (tnxpix (xp, yp, wcs, &xpi, &ypi)) + *offscl = 1; + } + + /* Use NOAO IRAF corrected zenithal projection */ + else if (wcs->prjcode == WCS_ZPX) { + if (zpxpix (xp, yp, wcs, &xpi, &ypi)) + *offscl = 1; + } + + /* Use Classic AIPS projections */ + else if (wcs->wcsproj == WCS_OLD || wcs->prjcode <= 0) { + if (worldpix (xp, yp, wcs, &xpi, &ypi)) + *offscl = 1; + } + + /* Use Mark Calabretta's WCSLIB projections */ + else if (wcspix (xp, yp, wcs, &xpi, &ypi)) { + *offscl = 1; + } + + /* If this WCS is converted from another WCS rather than pixels, convert now */ + if (wcs->wcs != NULL) { + wcsc2pix (wcs->wcs, xpi, ypi, NULL, xpix, ypix, offscl); + } + else { + foc2pix (wcs, xpi, ypi, xpix, ypix); + + /* Set off-scale flag to 2 if off image but within bounds of projection */ + if (!*offscl) { + if (*xpix < 0.5 || *ypix < 0.5) + *offscl = 2; + else if (*xpix > wcs->nxpix + 0.5 || *ypix > wcs->nypix + 0.5) + *offscl = 2; + } + } + + wcs->offscl = *offscl; + wcs->xpos = xpos; + wcs->ypos = ypos; + wcs->xpix = *xpix; + wcs->ypix = *ypix; + + return; +} + + +int +wcspos (xpix, ypix, wcs, xpos, ypos) + +/* Input: */ +double xpix; /* x pixel number (RA or long without rotation) */ +double ypix; /* y pixel number (dec or lat without rotation) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpos; /* x (RA) coordinate (deg) */ +double *ypos; /* y (dec) coordinate (deg) */ +{ + int offscl; + int i; + int wcsrevv(); + double wcscrd[4], imgcrd[4], pixcrd[4]; + double phi, theta; + + *xpos = 0.0; + *ypos = 0.0; + + pixcrd[0] = xpix; + pixcrd[1] = ypix; + if (wcs->prjcode == WCS_CSC || wcs->prjcode == WCS_QSC || + wcs->prjcode == WCS_TSC) + pixcrd[2] = (double) (izpix + 1); + else + pixcrd[2] = zpix; + pixcrd[3] = 1.0; + for (i = 0; i < 4; i++) + imgcrd[i] = 0.0; + offscl = wcsrevv ((void *)&wcs->ctype, &wcs->wcsl, pixcrd, &wcs->lin, imgcrd, + &wcs->prj, &phi, &theta, wcs->crval, &wcs->cel, wcscrd); + if (offscl == 0) { + *xpos = wcscrd[wcs->wcsl.lng]; + *ypos = wcscrd[wcs->wcsl.lat]; + } + + return (offscl); +} + +int +wcspix (xpos, ypos, wcs, xpix, ypix) + +/* Input: */ +double xpos; /* x (RA) coordinate (deg) */ +double ypos; /* y (dec) coordinate (deg) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpix; /* x pixel number (RA or long without rotation) */ +double *ypix; /* y pixel number (dec or lat without rotation) */ + +{ + int offscl; + int wcsfwd(); + double wcscrd[4], imgcrd[4], pixcrd[4]; + double phi, theta; + + *xpix = 0.0; + *ypix = 0.0; + if (wcs->wcsl.flag != WCSSET) { + if (wcssett (wcs->lin.naxis, (void *)&wcs->ctype, &wcs->wcsl) ) + return (1); + } + + /* Set input for WCSLIB subroutines */ + wcscrd[0] = 0.0; + wcscrd[1] = 0.0; + wcscrd[2] = 0.0; + wcscrd[3] = 0.0; + wcscrd[wcs->wcsl.lng] = xpos; + wcscrd[wcs->wcsl.lat] = ypos; + + /* Initialize output for WCSLIB subroutines */ + pixcrd[0] = 0.0; + pixcrd[1] = 0.0; + pixcrd[2] = 1.0; + pixcrd[3] = 1.0; + imgcrd[0] = 0.0; + imgcrd[1] = 0.0; + imgcrd[2] = 1.0; + imgcrd[3] = 1.0; + + /* Invoke WCSLIB subroutines for coordinate conversion */ + offscl = wcsfwd ((void *)&wcs->ctype, &wcs->wcsl, wcscrd, wcs->crval, &wcs->cel, + &phi, &theta, &wcs->prj, imgcrd, &wcs->lin, pixcrd); + + if (!offscl) { + *xpix = pixcrd[0]; + *ypix = pixcrd[1]; + if (wcs->prjcode == WCS_CSC || wcs->prjcode == WCS_QSC || + wcs->prjcode == WCS_TSC) + wcs->zpix = pixcrd[2] - 1.0; + else + wcs->zpix = pixcrd[2]; + } + return (offscl); +} + + +/* Set third dimension for cube projections */ + +int +wcszin (izpix0) + +int izpix0; /* coordinate in third dimension + (if < 0, return current value without changing it */ +{ + if (izpix0 > -1) { + izpix = izpix0; + zpix = (double) izpix0; + } + return (izpix); +} + + +/* Return third dimension for cube projections */ + +int +wcszout (wcs) + +struct WorldCoor *wcs; /* WCS parameter structure */ +{ + return ((int) wcs->zpix); +} + +/* Set file name for error messages */ +void +setwcsfile (filename) +char *filename; /* FITS or IRAF file with WCS */ +{ if (strlen (filename) < 256) + strcpy (wcsfile, filename); + else + strncpy (wcsfile, filename, 255); + return; } + +/* Set error message */ +void +setwcserr (errmsg) +char *errmsg; /* Error mesage < 80 char */ +{ strcpy (wcserrmsg, errmsg); return; } + +/* Print error message */ +void +wcserr () +{ if (strlen (wcsfile) > 0) + fprintf (stderr, "%s in file %s\n",wcserrmsg, wcsfile); + else + fprintf (stderr, "%s\n",wcserrmsg); + return; } + + +/* Flag to use AIPS WCS subroutines instead of WCSLIB */ +void +setdefwcs (wp) +int wp; +{ wcsproj0 = wp; return; } + +int +getdefwcs () +{ return (wcsproj0); } + +/* Save output default coordinate system */ +static char wcscoor0[16]; + +void +savewcscoor (wcscoor) +char *wcscoor; +{ strcpy (wcscoor0, wcscoor); return; } + +/* Return preset output default coordinate system */ +char * +getwcscoor () +{ return (wcscoor0); } + + +/* Save default commands */ +static char *wcscom0[10]; + +void +savewcscom (i, wcscom) +int i; +char *wcscom; +{ + int lcom; + if (i < 0) i = 0; + else if (i > 9) i = 9; + lcom = strlen (wcscom) + 2; + wcscom0[i] = (char *) calloc (lcom, 1); + if (wcscom0[i] != NULL) + strcpy (wcscom0[i], wcscom); + return; +} + +void +setwcscom (wcs) +struct WorldCoor *wcs; /* WCS parameter structure */ +{ + char envar[16]; + int i; + char *str; + if (nowcs(wcs)) + return; + for (i = 0; i < 10; i++) { + if (i == 0) + strcpy (envar, "WCS_COMMAND"); + else + sprintf (envar, "WCS_COMMAND%d", i); + if (wcscom0[i] != NULL) + wcscominit (wcs, i, wcscom0[i]); + else if ((str = getenv (envar)) != NULL) + wcscominit (wcs, i, str); + else if (i == 1) + wcscominit (wcs, i, "sua2 -ah %s"); /* F1= Search USNO-A2.0 Catalog */ + else if (i == 2) + wcscominit (wcs, i, "sgsc -ah %s"); /* F2= Search HST GSC */ + else if (i == 3) + wcscominit (wcs, i, "sty2 -ah %s"); /* F3= Search Tycho-2 Catalog */ + else if (i == 4) + wcscominit (wcs, i, "sppm -ah %s"); /* F4= Search PPM Catalog */ + else if (i == 5) + wcscominit (wcs, i, "ssao -ah %s"); /* F5= Search SAO Catalog */ + else + wcs->command_format[i] = NULL; + } + return; +} + +char * +getwcscom (i) +int i; +{ return (wcscom0[i]); } + + +void +freewcscom (wcs) +struct WorldCoor *wcs; /* WCS parameter structure */ +{ + int i; + for (i = 0; i < 10; i++) { + if (wcscom0[i] != NULL) { + free (wcscom0[i]); + wcscom0[i] = NULL; + } + } + if (iswcs (wcs)) { + for (i = 0; i < 10; i++) { + if (wcs->command_format[i] != NULL) { + free (wcs->command_format[i]); + } + } + } + return; +} + +int +cpwcs (header, cwcs) + +char **header; /* Pointer to start of FITS header */ +char *cwcs; /* Keyword suffix character for output WCS */ +{ + double tnum; + int dkwd[100]; + int i, maxnkwd, ikwd, nleft, lbuff, lhead, nkwd, nbytes; + int nkwdw; + char **kwd; + char *newhead, *oldhead; + char kwdc[16], keyword[16]; + char tstr[80]; + + /* Allocate array of keywords to be transferred */ + maxnkwd = 100; + kwd = (char **)calloc (maxnkwd, sizeof(char *)); + for (ikwd = 0; ikwd < maxnkwd; ikwd++) + kwd[ikwd] = (char *) calloc (16, 1); + + /* Make list of all possible keywords to be transferred */ + nkwd = 0; + strcpy (kwd[++nkwd], "EPOCH"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "EQUINOX"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "RADECSYS"); + dkwd[nkwd] = 0; + strcpy (kwd[++nkwd], "CTYPE1"); + dkwd[nkwd] = 0; + strcpy (kwd[++nkwd], "CTYPE2"); + dkwd[nkwd] = 0; + strcpy (kwd[++nkwd], "CRVAL1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CRVAL2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CDELT1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CDELT2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CRPIX1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CRPIX2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CROTA1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CROTA2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CD1_1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CD1_2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CD2_1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "CD2_2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC1_1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC1_2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC2_1"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC2_2"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC001001"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC001002"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC002001"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "PC002002"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "LATPOLE"); + dkwd[nkwd] = 1; + strcpy (kwd[++nkwd], "LONPOLE"); + dkwd[nkwd] = 1; + for (i = 1; i < 13; i++) { + sprintf (keyword,"CO1_%d", i); + strcpy (kwd[++nkwd], keyword); + dkwd[nkwd] = 1; + } + for (i = 1; i < 13; i++) { + sprintf (keyword,"CO2_%d", i); + strcpy (kwd[++nkwd], keyword); + dkwd[nkwd] = 1; + } + for (i = 0; i < 10; i++) { + sprintf (keyword,"PROJP%d", i); + strcpy (kwd[++nkwd], keyword); + dkwd[nkwd] = 1; + } + for (i = 0; i < MAXPV; i++) { + sprintf (keyword,"PV1_%d", i); + strcpy (kwd[++nkwd], keyword); + dkwd[nkwd] = 1; + } + for (i = 0; i < MAXPV; i++) { + sprintf (keyword,"PV2_%d", i); + strcpy (kwd[++nkwd], keyword); + dkwd[nkwd] = 1; + } + + /* Allocate new header buffer if needed */ + lhead = (ksearch (*header, "END") - *header) + 80; + lbuff = gethlength (*header); + nleft = (lbuff - lhead) / 80; + if (nleft < nkwd) { + nbytes = lhead + (nkwd * 80) + 400; + newhead = (char *) calloc (1, nbytes); + strncpy (newhead, *header, lhead); + oldhead = *header; + header = &newhead; + free (oldhead); + } + + /* Copy keywords to new WCS ID in header */ + nkwdw = 0; + for (i = 0; i < nkwd; i++) { + if (dkwd[i]) { + if (hgetr8 (*header, kwd[i], &tnum)) { + nkwdw++; + if (!strncmp (kwd[i], "PC0", 3)) { + if (!strcmp (kwd[i], "PC001001")) + strcpy (kwdc, "PC1_1"); + else if (!strcmp (kwd[i], "PC001002")) + strcpy (kwdc, "PC1_2"); + else if (!strcmp (kwd[i], "PC002001")) + strcpy (kwdc, "PC2_1"); + else + strcpy (kwdc, "PC2_2"); + } + else + strcpy (kwdc, kwd[i]); + strncat (kwdc, cwcs, 1); + (void)hputr8 (*header, kwdc, tnum); + } + } + else { + if (hgets (*header, kwd[i], 80, tstr)) { + nkwdw++; + if (!strncmp (kwd[i], "RADECSYS", 8)) + strcpy (kwdc, "RADECSY"); + else + strcpy (kwdc, kwd[i]); + strncat (kwdc, cwcs, 1); + hputs (*header, kwdc, tstr); + } + } + } + + /* Free keyword list array */ + for (ikwd = 0; ikwd < maxnkwd; ikwd++) + free (kwd[ikwd]); + free (kwd); + kwd = NULL; + return (nkwdw); +} + + +/* Oct 28 1994 new program + * Dec 21 1994 Implement CD rotation matrix + * Dec 22 1994 Allow RA and DEC to be either x,y or y,x + * + * Mar 6 1995 Add Digital Sky Survey plate fit + * May 2 1995 Add prototype of PIX2WCST to WCSCOM + * May 25 1995 Print leading zero for hours and degrees + * Jun 21 1995 Add WCS2PIX to get pixels from WCS + * Jun 21 1995 Read plate scale from FITS header for plate solution + * Jul 6 1995 Pass WCS structure as argument; malloc it in WCSINIT + * Jul 6 1995 Check string lengths in PIX2WCST + * Aug 16 1995 Add galactic coordinate conversion to PIX2WCST + * Aug 17 1995 Return 0 from iswcs if wcs structure is not yet set + * Sep 8 1995 Do not include malloc.h if VMS + * Sep 8 1995 Check for legal WCS before trying anything + * Sep 8 1995 Do not try to set WCS if missing key keywords + * Oct 18 1995 Add WCSCENT and WCSDIST to print center and size of image + * Nov 6 1995 Include stdlib.h instead of malloc.h + * Dec 6 1995 Fix format statement in PIX2WCST + * Dec 19 1995 Change MALLOC to CALLOC to initialize array to zeroes + * Dec 19 1995 Explicitly initialize rotation matrix and yinc + * Dec 22 1995 If SECPIX is set, use approximate WCS + * Dec 22 1995 Always print coordinate system + * + * Jan 12 1996 Use plane-tangent, not linear, projection if SECPIX is set + * Jan 12 1996 Add WCSSET to set WCS without an image + * Feb 15 1996 Replace all calls to HGETC with HGETS + * Feb 20 1996 Add tab table output from PIX2WCST + * Apr 2 1996 Convert all equinoxes to B1950 or J2000 + * Apr 26 1996 Get and use image epoch for accurate FK4/FK5 conversions + * May 16 1996 Clean up internal documentation + * May 17 1996 Return width in right ascension degrees, not sky degrees + * May 24 1996 Remove extraneous print command from WCSSIZE + * May 28 1996 Add NOWCS and WCSSHIFT subroutines + * Jun 11 1996 Drop unused variables after running lint + * Jun 12 1996 Set equinox as well as system in WCSSHIFT + * Jun 14 1996 Make DSS keyword searches more robust + * Jul 1 1996 Allow for SECPIX1 and SECPIX2 keywords + * Jul 2 1996 Test for CTYPE1 instead of CRVAL1 + * Jul 5 1996 Declare all subroutines in wcs.h + * Jul 19 1996 Add subroutine WCSFULL to return real image size + * Aug 12 1996 Allow systemless coordinates which cannot be converted + * Aug 15 1996 Allow LINEAR WCS to pass numbers through transparently + * Aug 15 1996 Add WCSERR to print error message under calling program control + * Aug 16 1996 Add latitude and longitude as image coordinate types + * Aug 26 1996 Fix arguments to HLENGTH in WCSNINIT + * Aug 28 1996 Explicitly set OFFSCL in WCS2PIX if coordinates outside image + * Sep 3 1996 Return computed pixel values even if they are offscale + * Sep 6 1996 Allow filename to be passed by WCSCOM + * Oct 8 1996 Default to 2000 for EQUINOX and EPOCH and FK5 for RADECSYS + * Oct 8 1996 If EPOCH is 0 and EQUINOX is not set, default to 1950 and FK4 + * Oct 15 1996 Add comparison when testing an assignment + * Oct 16 1996 Allow PIXEL CTYPE which means WCS is same as image coordinates + * Oct 21 1996 Add WCS_COMMAND environment variable + * Oct 25 1996 Add image scale to WCSCENT + * Oct 30 1996 Fix bugs in WCS2PIX + * Oct 31 1996 Fix CD matrix rotation angle computation + * Oct 31 1996 Use inline degree <-> radian conversion functions + * Nov 1 1996 Add option to change number of decimal places in PIX2WCST + * Nov 5 1996 Set wcs->crot to 1 if rotation matrix is used + * Dec 2 1996 Add altitide/azimuth coordinates + * Dec 13 1996 Fix search format setting from environment + * + * Jan 22 1997 Add ifdef for Eric Mandel (SAOtng) + * Feb 5 1997 Add wcsout for Eric Mandel + * Mar 20 1997 Drop unused variable STR in WCSCOM + * May 21 1997 Do not make pixel coordinates mod 360 in PIX2WCST + * May 22 1997 Add PIXEL prjcode = -1; + * Jul 11 1997 Get center pixel x and y from header even if no WCS + * Aug 7 1997 Add NOAO PIXSCALi keywords for default WCS + * Oct 15 1997 Do not reset reference pixel in WCSSHIFT + * Oct 20 1997 Set chip rotation + * Oct 24 1997 Keep longitudes between 0 and 360, not -180 and +180 + * Nov 5 1997 Do no compute crot and srot; they are now computed in worldpos + * Dec 16 1997 Set rotation and axis increments from CD matrix + * + * Jan 6 1998 Deal with J2000 and B1950 as EQUINOX values (from ST) + * Jan 7 1998 Read INSTRUME and DETECTOR header keywords + * Jan 7 1998 Fix tab-separated output + * Jan 9 1998 Precess coordinates if either FITS projection or *DSS plate* + * Jan 16 1998 Change PTYPE to not include initial hyphen + * Jan 16 1998 Change WCSSET to WCSXINIT to avoid conflict with Calabretta + * Jan 23 1998 Change PCODE to PRJCODE to avoid conflict with Calabretta + * Jan 27 1998 Add LATPOLE and LONGPOLE for Calabretta projections + * Feb 5 1998 Make cd and dc into vectors; use matinv() to invert cd + * Feb 5 1998 In wcsoutinit(), check that corsys is a valid pointer + * Feb 18 1998 Fix bugs for Calabretta projections + * Feb 19 1998 Add wcs structure access subroutines from Eric Mandel + * Feb 19 1998 Add wcsreset() to make sure derived values are reset + * Feb 19 1998 Always set oldwcs to 1 if NCP projection + * Feb 19 1998 Add subroutine to set oldwcs default + * Feb 20 1998 Initialize projection types one at a time for SunOS C + * Feb 23 1998 Add TNX projection from NOAO; treat it as TAN + * Feb 23 1998 Compute size based on max and min coordinates, not sides + * Feb 26 1998 Add code to set center pixel if part of detector array + * Mar 6 1998 Write 8-character values to RADECSYS + * Mar 9 1998 Add naxis to WCS structure + * Mar 16 1998 Use separate subroutine for IRAF TNX projection + * Mar 20 1998 Set PC matrix if more than two axes and it's not in header + * Mar 20 1998 Reset lin flag in WCSRESET if CDELTn + * Mar 20 1998 Set CD matrix with CDELTs and CROTA in wcsinit and wcsreset + * Mar 20 1998 Allow initialization of rotation angle alone + * Mar 23 1998 Use dsspos() and dsspix() instead of platepos() and platepix() + * Mar 24 1998 Set up PLT/PLATE plate polynomial fit using platepos() and platepix() + * Mar 25 1998 Read plate fit coefficients from header in getwcscoeffs() + * Mar 27 1998 Check for FITS WCS before DSS WCS + * Mar 27 1998 Compute scale from edges if xinc and yinc not set in wcscent() + * Apr 6 1998 Change plate coefficient keywords from PLTij to COi_j + * Apr 6 1998 Read all coefficients in line instead of with subroutine + * Apr 7 1998 Change amd_i_coeff to i_coeff + * Apr 8 1998 Add wcseqset to change equinox after wcs has been set + * Apr 10 1998 Use separate counters for x and y polynomial coefficients + * Apr 13 1998 Use CD/CDELT+CDROTA if oldwcs is set + * Apr 14 1998 Use codes instead of strings for various coordinate systems + * Apr 14 1998 Separate input coordinate conversion from output conversion + * Apr 14 1998 Use wcscon() for most coordinate conversion + * Apr 17 1998 Always compute cdelt[] + * Apr 17 1998 Deal with reversed axis more correctly + * Apr 17 1998 Compute rotation angle and approximate CDELTn for polynomial + * Apr 23 1998 Deprecate xref/yref in favor of crval[] + * Apr 23 1998 Deprecate xrefpix/yrefpix in favor of crpix[] + * Apr 23 1998 Add LINEAR to coordinate system types + * Apr 23 1998 Always use AIPS subroutines for LINEAR or PIXEL + * Apr 24 1998 Format linear coordinates better + * Apr 28 1998 Change coordinate system flags to WCS_* + * Apr 28 1998 Change projection flags to WCS_* + * Apr 28 1998 Add subroutine wcsc2pix for coordinates to pixels with system + * Apr 28 1998 Add setlinmode() to set output string mode for LINEAR coordinates + * Apr 30 1998 Fix bug by setting degree flag for lat and long in wcsinit() + * Apr 30 1998 Allow leading "-"s in projecting in wcsxinit() + * May 1 1998 Assign new output coordinate system only if legitimate system + * May 1 1998 Do not allow oldwcs=1 unless allowed projection + * May 4 1998 Fix bug in units reading for LINEAR coordinates + * May 6 1998 Initialize to no CD matrix + * May 6 1998 Use TAN instead of TNX if oldwcs + * May 12 1998 Set 3rd and 4th coordinates in wcspos() + * May 12 1998 Return *xpos and *ypos = 0 in pix2wcs() if offscale + * May 12 1998 Declare undeclared external subroutines after lint + * May 13 1998 Add equinox conversion to specified output equinox + * May 13 1998 Set output or input system to image with null argument + * May 15 1998 Return reference pixel, cdelts, and rotation for DSS + * May 20 1998 Fix bad bug so setlinmode() is no-op if wcs not set + * May 20 1998 Fix bug so getwcsout() returns null pointer if wcs not set + * May 27 1998 Change WCS_LPR back to WCS_LIN; allow CAR in oldwcs + * May 28 1998 Go back to old WCSFULL, computing height and width from center + * May 29 1998 Add wcskinit() to initialize WCS from arguments + * May 29 1998 Add wcstype() to set projection from arguments + * May 29 1998 Add wcscdset(), and wcsdeltset() to set scale from arguments + * Jun 1 1998 In wcstype(), reconstruct ctype for WCS structure + * Jun 11 1998 Split off header-dependent subroutines to wcsinit.c + * Jun 18 1998 Add wcspcset() for PC matrix initialization + * Jun 24 1998 Add string lengths to ra2str(), dec2str, and deg2str() calls + * Jun 25 1998 Use AIPS software for CAR projection + * Jun 25 1998 Add wcsndec to set number of decimal places in output string + * Jul 6 1998 Add wcszin() and wcszout() to use third dimension of images + * Jul 7 1998 Change setlinmode() to setwcslin(); setdegout() to setwcsdeg() + * Jul 10 1998 Initialize matrices correctly for naxis > 2 in wcs<>set() + * Jul 16 1998 Initialize coordinates to be returned in wcspos() + * Jul 17 1998 Link lin structure arrays to wcs structure arrays + * Jul 20 1998 In wcscdset() compute sign of xinc and yinc from CD1_1, CD 2_2 + * Jul 20 1998 In wcscdset() compute sign of rotation based on CD1_1, CD 1_2 + * Jul 22 1998 Add wcslibrot() to compute lin() rotation matrix + * Jul 30 1998 Set wcs->naxes and lin.naxis in wcsxinit() and wcskinit() + * Aug 5 1998 Use old WCS subroutines to deal with COE projection (for ESO) + * Aug 14 1998 Add option to print image coordinates with wcscom() + * Aug 14 1998 Add multiple command options to wcscom*() + * Aug 31 1998 Declare undeclared arguments to wcspcset() + * Sep 3 1998 Set CD rotation and cdelts from sky axis position angles + * Sep 16 1998 Add option to use North Polar Angle instead of Latitude + * Sep 29 1998 Initialize additional WCS commands from the environment + * Oct 14 1998 Fix bug in wcssize() which didn't divide dra by cos(dec) + * Nov 12 1998 Fix sign of CROTA when either axis is reflected + * Dec 2 1998 Fix non-arcsecond scale factors in wcscent() + * Dec 2 1998 Add PLANET coordinate system to pix2wcst() + + * Jan 20 1999 Free lin.imgpix and lin.piximg in wcsfree() + * Feb 22 1999 Fix bug setting latitude reference value of latbase != 0 + * Feb 22 1999 Fix bug so that quad cube faces are 0-5, not 1-6 + * Mar 16 1999 Always initialize all 4 imgcrds and pixcrds in wcspix() + * Mar 16 1999 Always return (0,0) from wcs2pix if offscale + * Apr 7 1999 Add code to put file name in error messages + * Apr 7 1999 Document utility subroutines at end of file + * May 6 1999 Fix bug printing height of LINEAR image + * Jun 16 1999 Add wcsrange() to return image RA and Dec limits + * Jul 8 1999 Always use FK5 and FK4 instead of J2000 and B1950 in RADECSYS + * Aug 16 1999 Print dd:mm:ss dd:mm:ss if not J2000 or B1950 output + * Aug 20 1999 Add WCS string argument to wcscom(); don't compute it there + * Aug 20 1999 Change F3 WCS command default from Tycho to ACT + * Oct 15 1999 Free wcs using wcsfree() + * Oct 21 1999 Drop declarations of unused functions after lint + * Oct 25 1999 Drop out of wcsfree() if wcs is null pointer + * Nov 17 1999 Fix bug which caused software to miss NCP projection + * + * Jan 24 2000 Default to AIPS for NCP, CAR, and COE proj.; if -z use WCSLIB + * Feb 24 2000 If coorsys is null in wcsc2pix, wcs->radecin is assumed + * May 10 2000 In wcstype(), default to WCS_LIN, not error (after Bill Joye) + * Jun 22 2000 In wcsrotset(), leave rotation angle alone in 1-d image + * Jul 3 2000 Initialize wcscrd[] to zero in wcspix() + * + * Feb 20 2001 Add recursion to wcs2pix() and pix2wcs() for dependent WCS's + * Mar 20 2001 Add braces to avoid ambiguity in if/else groupings + * Mar 22 2001 Free WCS structure in wcsfree even if it is not filled + * Sep 12 2001 Fix bug which omitted tab in pix2wcst() galactic coord output + * + * Mar 7 2002 Fix bug which gave wrong pa's and rotation for reflected RA + * (but correct WCS conversions!) + * Mar 28 2002 Add SZP projection + * Apr 3 2002 Synchronize projection types with other subroutines + * Apr 3 2002 Drop special cases of projections + * Apr 9 2002 Implement inversion of multiple WCSs in wcsc2pix() + * Apr 25 2002 Use Tycho-2 catalog instead of ACT in setwcscom() + * May 13 2002 Free WCSNAME in wcsfree() + * + * Mar 31 2003 Add distcode to wcstype() + * Apr 1 2003 Add calls to foc2pix() in wcs2pix() and pix2foc() in pix2wcs() + * May 20 2003 Declare argument i in savewcscom() + * Sep 29 2003 Fix bug to compute width and height correctly in wcsfull() + * Sep 29 2003 Fix bug to deal with all-sky images orrectly in wcsfull() + * Oct 1 2003 Rename wcs->naxes to wcs->naxis to match WCSLIB 3.2 + * Nov 3 2003 Set distortion code by calling setdistcode() in wcstype() + * Dec 3 2003 Add back wcs->naxes for compatibility + * Dec 3 2003 Add braces in if...else in pix2wcst() + * + * Sep 17 2004 If spherical coordinate output, keep 0 < long/RA < 360 + * Sep 17 2004 Fix bug in wcsfull() when wrapping around RA=0:00 + * Nov 1 2004 Keep wcs->rot between 0 and 360 + * + * Mar 9 2005 Fix bug in wcsrotset() which set rot > 360 to 360 + * Jun 27 2005 Fix ctype in calls to wcs subroutines + * Jul 21 2005 Fix bug in wcsrange() at RA ~= 0.0 + * + * Apr 24 2006 Always set inverse CD matrix to 2 dimensions in wcspcset() + * May 3 2006 (void *) pointers so arguments match type, from Robert Lupton + * Jun 30 2006 Set only 2-dimensional PC matrix; that is all lin* can deal with + * Oct 30 2006 In pix2wcs(), do not limit x to between 0 and 360 if XY or LINEAR + * Oct 30 2006 In wcsc2pix(), do not precess LINEAR or XY coordinates + * Dec 21 2006 Add cpwcs() to copy WCS keywords to new suffix + * + * Jan 4 2007 Fix pointer to header in cpwcs() + * Jan 5 2007 Drop declarations of wcscon(); it is in wcs.h + * Jan 9 2006 Drop declarations of fk425e() and fk524e(); moved to wcs.h + * Jan 9 2006 Drop *pix() and *pos() external declarations; moved to wcs.h + * Jan 9 2006 Drop matinv() external declaration; it is already in wcslib.h + * Feb 15 2007 If CTYPEi contains DET, set to WCS_PIX projection + * Feb 23 2007 Fix bug when checking for "DET" in CTYPEi + * Apr 2 2007 Fix PC to CD matrix conversion + * Jul 25 2007 Compute distance between two coordinates using d2v3() + * + * Apr 7 2010 In wcstype() set number of WCS projections from NWCSTYPE + * + * Mar 11 2011 Add NOAO ZPX projection (Frank Valdes) + * Mar 14 2011 Delete j<=MAXPV PVi_j parameters (for SCAMP polynomials via Ed Los) + * Mar 17 2011 Fix WCSDEP bug found by Ed Los + * May 9 2011 Free WCS structure recursively if WCSDEP is used + * Sep 1 2011 Add TPV projection type for SCAMP TAN with PVs + * + * Oct 19 2012 Drop d1 and d2 from wcsdist(); diffi from wcsdist1() + * Oct 19 2012 Drop depwcs; it's in main wcs structure + */ diff --git a/tksao/wcssubs/wcs.h b/tksao/wcssubs/wcs.h new file mode 100644 index 0000000..cef3dae --- /dev/null +++ b/tksao/wcssubs/wcs.h @@ -0,0 +1,969 @@ +/*** File libwcs/wcs.h + *** February 1, 2013 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1994-2013 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +#ifndef _wcs_h_ +#define _wcs_h_ + +#include "wcslib.h" +#include "fitshead.h" + +/* SIRTF distortion matrix coefficients */ +#define DISTMAX 10 +struct Distort { + int a_order; /* max power for the 1st dimension */ + double a[DISTMAX][DISTMAX]; /* coefficient array of 1st dimension */ + int b_order; /* max power for 1st dimension */ + double b[DISTMAX][DISTMAX]; /* coefficient array of 2nd dimension */ + int ap_order; /* max power for the 1st dimension */ + double ap[DISTMAX][DISTMAX]; /* coefficient array of 1st dimension */ + int bp_order; /* max power for 1st dimension */ + double bp[DISTMAX][DISTMAX]; /* coefficient array of 2nd dimension */ +}; + +struct WorldCoor { + double xref; /* X reference coordinate value (deg) */ + double yref; /* Y reference coordinate value (deg) */ + double xrefpix; /* X reference pixel */ + double yrefpix; /* Y reference pixel */ + double xinc; /* X coordinate increment (deg) */ + double yinc; /* Y coordinate increment (deg) */ + double rot; /* rotation around axis (deg) (N through E) */ + double cd[4]; /* rotation matrix */ + double dc[4]; /* inverse rotation matrix */ + double equinox; /* Equinox of coordinates default to 1950.0 */ + double epoch; /* Epoch of coordinates default to equinox */ + double nxpix; /* Number of pixels in X-dimension of image */ + double nypix; /* Number of pixels in Y-dimension of image */ + double plate_ra; /* Right ascension of plate center */ + double plate_dec; /* Declination of plate center */ + double plate_scale; /* Plate scale in arcsec/mm */ + double x_pixel_offset; /* X pixel offset of image lower right */ + double y_pixel_offset; /* Y pixel offset of image lower right */ + double x_pixel_size; /* X pixel_size */ + double y_pixel_size; /* Y pixel_size */ + double ppo_coeff[6]; /* pixel to plate coefficients for DSS */ + double x_coeff[20]; /* X coefficients for plate model */ + double y_coeff[20]; /* Y coefficients for plate model */ + double xpix; /* X (RA) coordinate (pixels) */ + double ypix; /* Y (dec) coordinate (pixels) */ + double zpix; /* Z (face) coordinate (pixels) */ + double xpos; /* X (RA) coordinate (deg) */ + double ypos; /* Y (dec) coordinate (deg) */ + double crpix[9]; /* Values of CRPIXn keywords */ + double crval[9]; /* Values of CRVALn keywords */ + double cdelt[9]; /* Values of CDELTn keywords */ + double pc[81]; /* Values of PCiiijjj keywords */ + double projp[10]; /* Constants for various projections */ + int pvfail; /* If non-zero, significant inaccuracy likely to occur in projection */ + double projppv[2*MAXPV]; /* SCAMP constants for the PV coordinates */ + struct poly *inv_x; /* SCAMP projection correction polynom in x */ + struct poly *inv_y; /* SCAMP projection correction polynom in y */ + double longpole; /* Longitude of North Pole in degrees */ + double latpole; /* Latitude of North Pole in degrees */ + double rodeg; /* Radius of the projection generating sphere */ + double imrot; /* Rotation angle of north pole */ + double pa_north; /* Position angle of north (0=horizontal) */ + double pa_east; /* Position angle of east (0=horizontal) */ + double radvel; /* Radial velocity (km/sec away from observer)*/ + double zvel; /* Radial velocity (v/c away from observer)*/ + double zpzd; /* Colat of FIP (degs) */ + double zpr; /* Radius of FIP (degs) */ + int imflip; /* If not 0, image is reflected around axis */ + int prjcode; /* projection code (-1-32) */ + int latbase; /* Latitude base 90 (NPA), 0 (LAT), -90 (SPA) */ + int ncoeff1; /* Number of x-axis plate fit coefficients */ + int ncoeff2; /* Number of y-axis plate fit coefficients */ + int zpnp; /* ZP polynomial order (0-9) */ + int changesys; /* 1 for FK4->FK5, 2 for FK5->FK4 */ + /* 3 for FK4->galactic, 4 for FK5->galactic */ + int printsys; /* 1 to print coordinate system, else 0 */ + int ndec; /* Number of decimal places in PIX2WCST */ + int degout; /* 1 to always print degrees in PIX2WCST */ + int tabsys; /* 1 to put tab between RA & Dec, else 0 */ + int rotmat; /* 0 if CDELT, CROTA; 1 if CD */ + int coorflip; /* 0 if x=RA, y=Dec; 1 if x=Dec, y=RA */ + int offscl; /* 0 if OK, 1 if offscale */ + int wcson; /* 1 if WCS is set, else 0 */ + int naxis; /* Number of axes in image (for WCSLIB 3.0) */ + int naxes; /* Number of axes in image */ + int wcsproj; /* WCS_OLD: AIPS worldpos() and worldpix() + WCS_NEW: Mark Calabretta's WCSLIB subroutines + WCS_BEST: WCSLIB for all but CAR,COE,NCP + WCS_ALT: AIPS for all but CAR,COE,NCP */ + int linmode; /* 0=system only, 1=units, 2=system+units */ + int detector; /* Instrument detector number */ + char instrument[32]; /* Instrument name */ + char ctype[9][9]; /* Values of CTYPEn keywords */ + char c1type[9]; /* 1st coordinate type code: + RA--, GLON, ELON */ + char c2type[9]; /* 2nd coordinate type code: + DEC-, GLAT, ELAT */ + char ptype[9]; /* projection type code: + SIN, TAN, ARC, NCP, GLS, MER, AIT, etc */ + char units[9][32]; /* Units if LINEAR */ + char radecsys[32]; /* Reference frame: FK4, FK4-NO-E, FK5, GAPPT*/ + char radecout[32]; /* Output reference frame: FK4,FK5,GAL,ECL */ + char radecin[32]; /* Input reference frame: FK4,FK5,GAL,ECL */ + double eqin; /* Input equinox (match sysin if 0.0) */ + double eqout; /* Output equinox (match sysout if 0.0) */ + int sysin; /* Input coordinate system code */ + int syswcs; /* WCS coordinate system code */ + int sysout; /* Output coordinate system code */ + /* WCS_B1950, WCS_J2000, WCS_ICRS, WCS_GALACTIC, + * WCS_ECLIPTIC, WCS_LINEAR, WCS_ALTAZ */ + char center[32]; /* Center coordinates (with frame) */ + struct wcsprm wcsl; /* WCSLIB main projection parameters */ + struct linprm lin; /* WCSLIB image/pixel conversion parameters */ + struct celprm cel; /* WCSLIB projection type */ + struct prjprm prj; /* WCSLIB projection parameters */ + struct IRAFsurface *lngcor; /* RA/longitude correction structure */ + struct IRAFsurface *latcor; /* Dec/latitude correction structure */ + int distcode; /* Distortion code 0=none 1=SIRTF */ + struct Distort distort; /* SIRTF distortion coefficients */ + char *command_format[10]; /* WCS command formats */ + /* where %s is replaced by WCS coordinates */ + /* where %f is replaced by the image filename */ + /* where %x is replaced by image coordinates */ + double ltm[4]; /* Image rotation matrix */ + double ltv[2]; /* Image offset */ + int idpix[2]; /* First pixel to use in image (x, y) */ + int ndpix[2]; /* Number of pixels to use in image (x, y) */ + struct WorldCoor *wcs; /* WCS upon which this WCS depends */ + struct WorldCoor *wcsdep; /* WCS depending on this WCS */ + char *wcsname; /* WCS name (defaults to NULL pointer) */ + char wcschar; /* WCS character (A-Z, null, space) */ + int logwcs; /* 1 if DC-FLAG is set for log wavelength */ +}; + +/* Projections (1-26 are WCSLIB) (values for wcs->prjcode) */ +#define WCS_PIX -1 /* Pixel WCS */ +#define WCS_LIN 0 /* Linear projection */ +#define WCS_AZP 1 /* Zenithal/Azimuthal Perspective */ +#define WCS_SZP 2 /* Zenithal/Azimuthal Perspective */ +#define WCS_TAN 3 /* Gnomonic = Tangent Plane */ +#define WCS_SIN 4 /* Orthographic/synthesis */ +#define WCS_STG 5 /* Stereographic */ +#define WCS_ARC 6 /* Zenithal/azimuthal equidistant */ +#define WCS_ZPN 7 /* Zenithal/azimuthal PolyNomial */ +#define WCS_ZEA 8 /* Zenithal/azimuthal Equal Area */ +#define WCS_AIR 9 /* Airy */ +#define WCS_CYP 10 /* CYlindrical Perspective */ +#define WCS_CAR 11 /* Cartesian */ +#define WCS_MER 12 /* Mercator */ +#define WCS_CEA 13 /* Cylindrical Equal Area */ +#define WCS_COP 14 /* Conic PerSpective (COP) */ +#define WCS_COD 15 /* COnic equiDistant */ +#define WCS_COE 16 /* COnic Equal area */ +#define WCS_COO 17 /* COnic Orthomorphic */ +#define WCS_BON 18 /* Bonne */ +#define WCS_PCO 19 /* Polyconic */ +#define WCS_SFL 20 /* Sanson-Flamsteed (GLobal Sinusoidal) */ +#define WCS_PAR 21 /* Parabolic */ +#define WCS_AIT 22 /* Hammer-Aitoff */ +#define WCS_MOL 23 /* Mollweide */ +#define WCS_CSC 24 /* COBE quadrilateralized Spherical Cube */ +#define WCS_QSC 25 /* Quadrilateralized Spherical Cube */ +#define WCS_TSC 26 /* Tangential Spherical Cube */ +#define WCS_NCP 27 /* Special case of SIN */ +#define WCS_GLS 28 /* Same as SFL */ +#define WCS_DSS 29 /* Digitized Sky Survey plate solution */ +#define WCS_PLT 30 /* Plate fit polynomials (SAO) */ +#define WCS_TNX 31 /* Gnomonic = Tangent Plane (NOAO with corrections) */ +#define WCS_ZPX 32 /* Gnomonic = Tangent Plane (NOAO with corrections) */ +#define WCS_TPV 33 /* Gnomonic = Tangent Plane (NOAO with corrections) */ +#define NWCSTYPE 34 /* Number of WCS types (-1 really means no WCS) */ + +/* Coordinate systems */ +#define WCS_J2000 1 /* J2000(FK5) right ascension and declination */ +#define WCS_B1950 2 /* B1950(FK4) right ascension and declination */ +#define WCS_GALACTIC 3 /* Galactic longitude and latitude */ +#define WCS_ECLIPTIC 4 /* Ecliptic longitude and latitude */ +#define WCS_ALTAZ 5 /* Azimuth and altitude/elevation */ +#define WCS_LINEAR 6 /* Linear with optional units */ +#define WCS_NPOLE 7 /* Longitude and north polar angle */ +#define WCS_SPA 8 /* Longitude and south polar angle */ +#define WCS_PLANET 9 /* Longitude and latitude on planet */ +#define WCS_XY 10 /* X-Y Cartesian coordinates */ +#define WCS_ICRS 11 /* ICRS right ascension and declination */ + +/* Method to use */ +#define WCS_BEST 0 /* Use best WCS projections */ +#define WCS_ALT 1 /* Use not best WCS projections */ +#define WCS_OLD 2 /* Use AIPS WCS projections */ +#define WCS_NEW 3 /* Use WCSLIB 2.5 WCS projections */ + +/* Distortion codes (values for wcs->distcode) */ +#define DISTORT_NONE 0 /* No distortion coefficients */ +#define DISTORT_SIRTF 1 /* SIRTF distortion matrix */ + +#ifndef PI +#define PI 3.141592653589793238462643 +#endif + +/* pi/(180*3600): arcseconds to radians */ +#define AS2R 4.8481368110953e-6 + +/* Conversions among hours of RA, degrees and radians. */ +#define degrad(x) ((x)*PI/180.) +#define raddeg(x) ((x)*180./PI) +#define hrdeg(x) ((x)*15.) +#define deghr(x) ((x)/15.) +#define hrrad(x) degrad(hrdeg(x)) +#define radhr(x) deghr(raddeg(x)) +#define secrad(x) ((x)*AS2R) + +/* TNX/ZPX surface fitting structure and flags */ +struct IRAFsurface { + double xrange; /* 2. / (xmax - xmin), polynomials */ + double xmaxmin; /* - (xmax + xmin) / 2., polynomials */ + double yrange; /* 2. / (ymax - ymin), polynomials */ + double ymaxmin; /* - (ymax + ymin) / 2., polynomials */ + int type; /* type of curve to be fitted */ + int xorder; /* order of the fit in x */ + int yorder; /* order of the fit in y */ + int xterms; /* cross terms for polynomials */ + int ncoeff; /* total number of coefficients */ + double *coeff; /* pointer to coefficient vector */ + double *xbasis; /* pointer to basis functions (all x) */ + double *ybasis; /* pointer to basis functions (all y) */ +}; + +/* TNX/ZPX permitted types of surfaces */ +#define TNX_CHEBYSHEV 1 +#define TNX_LEGENDRE 2 +#define TNX_POLYNOMIAL 3 + +/* TNX/ZPX cross-terms flags */ +#define TNX_XNONE 0 /* no x-terms (old no) */ +#define TNX_XFULL 1 /* full x-terms (new yes) */ +#define TNX_XHALF 2 /* half x-terms (new) */ + +#ifdef __cplusplus /* C++ prototypes */ +extern "C" { +#endif + +#ifdef __STDC__ /* Full ANSI prototypes */ + + /* WCS data structure initialization subroutines in wcsinit.c */ + struct WorldCoor *wcsinit ( /* set up WCS structure from a FITS image header */ + const char* hstring); + + struct WorldCoor *wcsninit ( /* set up WCS structure from a FITS image header */ + const char* hstring, /* FITS header */ + int len); /* Length of FITS header */ + + struct WorldCoor *wcsinitn ( /* set up WCS structure from a FITS image header */ + const char* hstring, /* FITS header */ + const char* wcsname); /* WCS name */ + + struct WorldCoor *wcsninitn ( /* set up WCS structure from a FITS image header */ + const char* hstring, /* FITS header */ + int len, /* Length of FITS header */ + const char* wcsname); /* WCS name */ + + struct WorldCoor *wcsinitc ( /* set up WCS structure from a FITS image header */ + const char* hstring, /* FITS header */ + char *wcschar); /* WCS character (A-Z) */ + + struct WorldCoor *wcsninitc ( /* set up WCS structure from a FITS image header */ + const char* hstring, /* FITS header */ + int len, /* Length of FITS header */ + char *wcschar); /* WCS character (A-Z) */ + char *uppercase ( /* Convert string of any case to uppercase */ + const char *string); /* String to convert */ + + /* WCS subroutines in wcs.c */ + void wcsfree ( /* Free a WCS structure and its contents */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + int wcstype( /* Set projection type from header CTYPEs */ + struct WorldCoor *wcs, /* World coordinate system structure */ + char *ctype1, /* FITS WCS projection for axis 1 */ + char *ctype2); /* FITS WCS projection for axis 2 */ + + int iswcs( /* Returns 1 if wcs structure set, else 0 */ + struct WorldCoor *wcs); /* World coordinate system structure */ + int nowcs( /* Returns 0 if wcs structure set, else 1 */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + int pix2wcst ( /* Convert pixel coordinates to World Coordinate string */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double xpix, /* Image horizontal coordinate in pixels */ + double ypix, /* Image vertical coordinate in pixels */ + char *wcstring, /* World coordinate string (returned) */ + int lstr); /* Length of world coordinate string (returned) */ + + void pix2wcs ( /* Convert pixel coordinates to World Coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double xpix, /* Image horizontal coordinate in pixels */ + double ypix, /* Image vertical coordinate in pixels */ + double *xpos, /* Longitude/Right Ascension in degrees (returned) */ + double *ypos); /* Latitude/Declination in degrees (returned) */ + + void wcsc2pix ( /* Convert World Coordinates to pixel coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double xpos, /* Longitude/Right Ascension in degrees */ + double ypos, /* Latitude/Declination in degrees */ + char *coorsys, /* Coordinate system (B1950, J2000, etc) */ + double *xpix, /* Image horizontal coordinate in pixels (returned) */ + double *ypix, /* Image vertical coordinate in pixels (returned) */ + int *offscl); + + void wcs2pix ( /* Convert World Coordinates to pixel coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double xpos, /* Longitude/Right Ascension in degrees */ + double ypos, /* Latitude/Declination in degrees */ + double *xpix, /* Image horizontal coordinate in pixels (returned) */ + double *ypix, /* Image vertical coordinate in pixels (returned) */ + int *offscl); + + double wcsdist( /* Compute angular distance between 2 sky positions */ + double ra1, /* First longitude/right ascension in degrees */ + double dec1, /* First latitude/declination in degrees */ + double ra2, /* Second longitude/right ascension in degrees */ + double dec2); /* Second latitude/declination in degrees */ + + double wcsdist1( /* Compute angular distance between 2 sky positions */ + double ra1, /* First longitude/right ascension in degrees */ + double dec1, /* First latitude/declination in degrees */ + double ra2, /* Second longitude/right ascension in degrees */ + double dec2); /* Second latitude/declination in degrees */ + + double wcsdiff( /* Compute angular distance between 2 sky positions */ + double ra1, /* First longitude/right ascension in degrees */ + double dec1, /* First latitude/declination in degrees */ + double ra2, /* Second longitude/right ascension in degrees */ + double dec2); /* Second latitude/declination in degrees */ + + struct WorldCoor* wcsxinit( /* set up a WCS structure from arguments */ + double cra, /* Center right ascension in degrees */ + double cdec, /* Center declination in degrees */ + double secpix, /* Number of arcseconds per pixel */ + double xrpix, /* Reference pixel X coordinate */ + double yrpix, /* Reference pixel X coordinate */ + int nxpix, /* Number of pixels along x-axis */ + int nypix, /* Number of pixels along y-axis */ + double rotate, /* Rotation angle (clockwise positive) in degrees */ + int equinox, /* Equinox of coordinates, 1950 and 2000 supported */ + double epoch, /* Epoch of coordinates, used for FK4/FK5 conversion + * no effect if 0 */ + char *proj); /* Projection */ + + struct WorldCoor* wcskinit( /* set up WCS structure from keyword values */ + int naxis1, /* Number of pixels along x-axis */ + int naxis2, /* Number of pixels along y-axis */ + char *ctype1, /* FITS WCS projection for axis 1 */ + char *ctype2, /* FITS WCS projection for axis 2 */ + double crpix1, /* Reference pixel coordinates */ + double crpix2, /* Reference pixel coordinates */ + double crval1, /* Coordinate at reference pixel in degrees */ + double crval2, /* Coordinate at reference pixel in degrees */ + double *cd, /* Rotation matrix, used if not NULL */ + double cdelt1, /* scale in degrees/pixel, if cd is NULL */ + double cdelt2, /* scale in degrees/pixel, if cd is NULL */ + double crota, /* Rotation angle in degrees, if cd is NULL */ + int equinox, /* Equinox of coordinates, 1950 and 2000 supported */ + double epoch); /* Epoch of coordinates, for FK4/FK5 conversion */ + + void wcsshift( /* Change center of WCS */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double cra, /* New center right ascension in degrees */ + double cdec, /* New center declination in degrees */ + char *coorsys); /* FK4 or FK5 coordinates (1950 or 2000) */ + + void wcsfull( /* Return RA and Dec of image center, size in degrees */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double *cra, /* Right ascension of image center (deg) (returned) */ + double *cdec, /* Declination of image center (deg) (returned) */ + double *width, /* Width in degrees (returned) */ + double *height); /* Height in degrees (returned) */ + + void wcscent( /* Print the image center and size in WCS units */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + void wcssize( /* Return image center and size in RA and Dec */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double *cra, /* Right ascension of image center (deg) (returned) */ + double *cdec, /* Declination of image center (deg) (returned) */ + double *dra, /* Half-width in right ascension (deg) (returned) */ + double *ddec); /* Half-width in declination (deg) (returned) */ + + void wcsrange( /* Return min and max RA and Dec of image in degrees */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double *ra1, /* Min. right ascension of image (deg) (returned) */ + double *ra2, /* Max. right ascension of image (deg) (returned) */ + double *dec1, /* Min. declination of image (deg) (returned) */ + double *dec2); /* Max. declination of image (deg) (returned) */ + + void wcscdset( /* Set scaling and rotation from CD matrix */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double *cd); /* CD matrix, ignored if NULL */ + + void wcsdeltset( /* set scaling, rotation from CDELTi, CROTA2 */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double cdelt1, /* degrees/pixel in first axis (or both axes) */ + double cdelt2, /* degrees/pixel in second axis if nonzero */ + double crota); /* Rotation counterclockwise in degrees */ + + void wcspcset( /* set scaling, rotation from CDELTs and PC matrix */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double cdelt1, /* degrees/pixel in first axis (or both axes) */ + double cdelt2, /* degrees/pixel in second axis if nonzero */ + double *pc); /* Rotation matrix, ignored if NULL */ + + void setwcserr( /* Set WCS error message for later printing */ + char *errmsg); /* Error mesage < 80 char */ + void wcserr(void); /* Print WCS error message to stderr */ + + void setdefwcs( /* Set flag to use AIPS WCS instead of WCSLIB */ + int oldwcs); /* 1 for AIPS WCS subroutines, else WCSLIB */ + int getdefwcs(void); /* Return flag for AIPS WCS set by setdefwcs */ + + char *getradecsys( /* Return name of image coordinate system */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + void wcsoutinit( /* Set output coordinate system for pix2wcs */ + struct WorldCoor *wcs, /* World coordinate system structure */ + char *coorsys); /* Coordinate system (B1950, J2000, etc) */ + + char *getwcsout( /* Return current output coordinate system */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + void wcsininit( /* Set input coordinate system for wcs2pix */ + struct WorldCoor *wcs, /* World coordinate system structure */ + char *coorsys); /* Coordinate system (B1950, J2000, etc) */ + + char *getwcsin( /* Return current input coordinate system */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + int setwcsdeg( /* Set WCS coordinate output format */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int degout); /* 1= degrees, 0= hh:mm:ss dd:mm:ss */ + + int wcsndec( /* Set or get number of output decimal places */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int ndec); /* Number of decimal places in output string + if < 0, return current ndec unchanged */ + + int wcsreset( /* Change WCS using arguments */ + struct WorldCoor *wcs, /* World coordinate system data structure */ + double crpix1, /* Horizontal reference pixel */ + double crpix2, /* Vertical reference pixel */ + double crval1, /* Reference pixel horizontal coordinate in degrees */ + double crval2, /* Reference pixel vertical coordinate in degrees */ + double cdelt1, /* Horizontal scale in degrees/pixel, ignored if cd is not NULL */ + double cdelt2, /* Vertical scale in degrees/pixel, ignored if cd is not NULL */ + double crota, /* Rotation angle in degrees, ignored if cd is not NULL */ + double *cd); /* Rotation matrix, used if not NULL */ + + void wcseqset( /* Change equinox of reference pixel coordinates in WCS */ + struct WorldCoor *wcs, /* World coordinate system data structure */ + double equinox); /* Desired equinox as fractional year */ + + void setwcslin( /* Set pix2wcst() mode for LINEAR coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int mode); /* 0: x y linear, 1: x units x units + 2: x y linear units */ + + int wcszin( /* Set third dimension for cube projections */ + int izpix); /* Set coordinate in third dimension (face) */ + + int wcszout ( /* Return coordinate in third dimension */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + void wcscominit( /* Initialize catalog search command set by -wcscom */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int i, /* Number of command (0-9) to initialize */ + char *command); /* command with %s where coordinates will go */ + + void wcscom( /* Execute catalog search command set by -wcscom */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int i, /* Number of command (0-9) to execute */ + char *filename, /* Image file name */ + double xfile, /* Horizontal image pixel coordinates for WCS command */ + double yfile, /* Vertical image pixel coordinates for WCS command */ + char *wcstring); /* WCS String from pix2wcst() */ + + void savewcscom( /* Save WCS shell command */ + int i, /* i of 10 possible shell commands */ + char *wcscom); /* Shell command using output WCS string */ + char *getwcscom( /* Return WCS shell command */ + int i); /* i of 10 possible shell commands */ + void setwcscom( /* Set WCS shell commands from stored values */ + struct WorldCoor *wcs); /* World coordinate system structure */ + void freewcscom( /* Free memory storing WCS shell commands */ + struct WorldCoor *wcs); /* World coordinate system structure */ + + void setwcsfile( /* Set filename for WCS error message */ + char *filename); /* FITS or IRAF file name */ + int cpwcs ( /* Copy WCS keywords with no suffix to ones with suffix */ + char **header, /* Pointer to start of FITS header */ + char *cwcs); /* Keyword suffix character for output WCS */ + + void savewcscoor( /* Save output coordinate system */ + char *wcscoor); /* coordinate system (J2000, B1950, galactic) */ + char *getwcscoor(void); /* Return output coordinate system */ + + /* Coordinate conversion subroutines in wcscon.c */ + void wcsconv( /* Convert between coordinate systems and equinoxes */ + int sys1, /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ + int sys2, /* Output coordinate system (J2000, B1950, ECLIPTIC, G ALACTIC */ + double eq1, /* Input equinox (default of sys1 if 0.0) */ + double eq2, /* Output equinox (default of sys2 if 0.0) */ + double ep1, /* Input Besselian epoch in years */ + double ep2, /* Output Besselian epoch in years */ + double *dtheta, /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ + double *dphi, /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ + double *ptheta, /* Longitude or right ascension proper motion in deg/year + Input in sys1, returned in sys2 */ + double *pphi, /* Latitude or declination proper motion in deg/year */ + double *px, /* Parallax in arcseconds */ + double *rv); /* Radial velocity in km/sec */ + void wcsconp( /* Convert between coordinate systems and equinoxes */ + int sys1, /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ + int sys2, /* Output coordinate system (J2000, B1950, ECLIPTIC, G ALACTIC */ + double eq1, /* Input equinox (default of sys1 if 0.0) */ + double eq2, /* Output equinox (default of sys2 if 0.0) */ + double ep1, /* Input Besselian epoch in years */ + double ep2, /* Output Besselian epoch in years */ + double *dtheta, /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ + double *dphi, /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ + double *ptheta, /* Longitude or right ascension proper motion in degrees/year + Input in sys1, returned in sys2 */ + double *pphi); /* Latitude or declination proper motion in degrees/year + Input in sys1, returned in sys2 */ + void wcscon( /* Convert between coordinate systems and equinoxes */ + int sys1, /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ + int sys2, /* Output coordinate system (J2000, B1950, ECLIPTIC, G ALACTIC */ + double eq1, /* Input equinox (default of sys1 if 0.0) */ + double eq2, /* Output equinox (default of sys2 if 0.0) */ + double *dtheta, /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ + double *dphi, /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ + double epoch); /* Besselian epoch in years */ + void fk425e ( /* Convert B1950(FK4) to J2000(FK5) coordinates */ + double *ra, /* Right ascension in degrees (B1950 in, J2000 out) */ + double *dec, /* Declination in degrees (B1950 in, J2000 out) */ + double epoch); /* Besselian epoch in years */ + void fk524e ( /* Convert J2000(FK5) to B1950(FK4) coordinates */ + double *ra, /* Right ascension in degrees (J2000 in, B1950 out) */ + double *dec, /* Declination in degrees (J2000 in, B1950 out) */ + double epoch); /* Besselian epoch in years */ + int wcscsys( /* Return code for coordinate system in string */ + char *coorsys); /* Coordinate system (B1950, J2000, etc) */ + double wcsceq ( /* Set equinox from string (return 0.0 if not obvious) */ + char *wcstring); /* Coordinate system (B1950, J2000, etc) */ + void wcscstr ( /* Set coordinate system type string from system and equinox */ + char *cstr, /* Coordinate system string (returned) */ + int syswcs, /* Coordinate system code */ + double equinox, /* Equinox of coordinate system */ + double epoch); /* Epoch of coordinate system */ + void d2v3 ( /* Convert RA and Dec in degrees and distance to vector */ + double rra, /* Right ascension in degrees */ + double rdec, /* Declination in degrees */ + double r, /* Distance to object in same units as pos */ + double pos[3]); /* x,y,z geocentric equatorial position of object (returned) */ + void s2v3 ( /* Convert RA and Dec in radians and distance to vector */ + double rra, /* Right ascension in radians */ + double rdec, /* Declination in radians */ + double r, /* Distance to object in same units as pos */ + double pos[3]); /* x,y,z geocentric equatorial position of object (returned) */ + void v2d3 ( /* Convert vector to RA and Dec in degrees and distance */ + double pos[3], /* x,y,z geocentric equatorial position of object */ + double *rra, /* Right ascension in degrees (returned) */ + double *rdec, /* Declination in degrees (returned) */ + double *r); /* Distance to object in same units as pos (returned) */ + void v2s3 ( /* Convert vector to RA and Dec in radians and distance */ + double pos[3], /* x,y,z geocentric equatorial position of object */ + double *rra, /* Right ascension in radians (returned) */ + double *rdec, /* Declination in radians (returned) */ + double *r); /* Distance to object in same units as pos (returned) */ + +/* Distortion model subroutines in distort.c */ + void distortinit ( /* Set distortion coefficients from FITS header */ + struct WorldCoor *wcs, /* World coordinate system structure */ + const char* hstring); /* FITS header */ + void setdistcode ( /* Set WCS distortion code string from CTYPEi value */ + struct WorldCoor *wcs, /* World coordinate system structure */ + char *ctype); /* CTYPE value from FITS header */ + char *getdistcode ( /* Return distortion code string for CTYPEi */ + struct WorldCoor *wcs); /* World coordinate system structure */ + int DelDistort ( /* Delete all distortion-related fields */ + char *header, /* FITS header */ + int verbose); /* If !=0, print keywords as deleted */ + void pix2foc ( /* Convert pixel to focal plane coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double x, /* Image pixel horizontal coordinate */ + double y, /* Image pixel vertical coordinate */ + double *u, /* Focal plane horizontal coordinate(returned) */ + double *v); /* Focal plane vertical coordinate (returned) */ + void foc2pix ( /* Convert focal plane to pixel coordinates */ + struct WorldCoor *wcs, /* World coordinate system structure */ + double u, /* Focal plane horizontal coordinate */ + double v, /* Focal plane vertical coordinate */ + double *x, /* Image pixel horizontal coordinate(returned) */ + double *y); /* Image pixel vertical coordinate (returned) */ + +/* Other projection subroutines */ + +/* 8 projections using AIPS algorithms (worldpos.c) */ + int worldpos ( /* Convert from pixel location to RA,Dec */ + double xpix, /* x pixel number (RA or long without rotation) */ + double ypix, /* y pixel number (Dec or lat without rotation) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpos, /* x (RA) coordinate (deg) (returned) */ + double *ypos); /* y (dec) coordinate (deg) (returned) */ + int worldpix ( /* Convert from RA,Dec to pixel location */ + double xpos, /* x (RA) coordinate (deg) */ + double ypos, /* y (dec) coordinate (deg) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpix, /* x pixel number (RA or long without rotation) */ + double *ypix); /* y pixel number (dec or lat without rotation) */ + +/* Digital Sky Survey projection (dsspos.c) */ + int dsspos ( /* Convert from pixel location to RA,Dec */ + double xpix, /* x pixel number (RA or long without rotation) */ + double ypix, /* y pixel number (Dec or lat without rotation) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpos, /* x (RA) coordinate (deg) (returned) */ + double *ypos); /* y (dec) coordinate (deg) (returned) */ + int dsspix ( /* Convert from RA,Dec to pixel location */ + double xpos, /* x (RA) coordinate (deg) */ + double ypos, /* y (dec) coordinate (deg) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpix, /* x pixel number (RA or long without rotation) */ + double *ypix); /* y pixel number (dec or lat without rotation) */ + +/* SAO TDC TAN projection with higher order terms (platepos.c) */ + int platepos ( /* Convert from pixel location to RA,Dec */ + double xpix, /* x pixel number (RA or long without rotation) */ + double ypix, /* y pixel number (Dec or lat without rotation) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpos, /* x (RA) coordinate (deg) (returned) */ + double *ypos); /* y (dec) coordinate (deg) (returned) */ + int platepix ( /* Convert from RA,Dec to pixel location */ + double xpos, /* x (RA) coordinate (deg) */ + double ypos, /* y (dec) coordinate (deg) */ + struct WorldCoor *wcs, /* WCS parameter structure */ + double *xpix, /* x pixel number (RA or long without rotation) */ + double *ypix); /* y pixel number (dec or lat without rotation) */ + void SetFITSPlate ( /* Set FITS header plate fit coefficients from structure */ + char *header, /* Image FITS header */ + struct WorldCoor *wcs); /* WCS structure */ + int SetPlate ( /* Set plate fit coefficients in structure from arguments */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int ncoeff1, /* Number of coefficients for x */ + int ncoeff2, /* Number of coefficients for y */ + double *coeff); /* Plate fit coefficients */ + int GetPlate ( /* Return plate fit coefficients from structure in arguments */ + struct WorldCoor *wcs, /* World coordinate system structure */ + int *ncoeff1, /* Number of coefficients for x */ + int *ncoeff2, /* Number of coefficients for y) */ + double *coeff); /* Plate fit coefficients */ + +/* IRAF TAN projection with higher order terms (tnxpos.c) */ + int tnxinit ( /* initialize the gnomonic forward or inverse transform */ + const char *header, /* FITS header */ + struct WorldCoor *wcs); /* pointer to WCS structure */ + int tnxpos ( /* forward transform (physical to world) gnomonic projection. */ + double xpix, /* Image X coordinate */ + double ypix, /* Image Y coordinate */ + struct WorldCoor *wcs, /* pointer to WCS descriptor */ + double *xpos, /* Right ascension (returned) */ + double *ypos); /* Declination (returned) */ + int tnxpix ( /* Inverse transform (world to physical) gnomonic projection */ + double xpos, /* Right ascension */ + double ypos, /* Declination */ + struct WorldCoor *wcs, /* Pointer to WCS descriptor */ + double *xpix, /* Image X coordinate (returned) */ + double *ypix); /* Image Y coordinate (returned) */ + +/* IRAF ZPN projection with higher order terms (zpxpos.c) */ + int zpxinit ( /* initialize the zenithal forward or inverse transform */ + const char *header, /* FITS header */ + struct WorldCoor *wcs); /* pointer to WCS structure */ + int zpxpos ( /* forward transform (physical to world) */ + double xpix, /* Image X coordinate */ + double ypix, /* Image Y coordinate */ + struct WorldCoor *wcs, /* pointer to WCS descriptor */ + double *xpos, /* Right ascension (returned) */ + double *ypos); /* Declination (returned) */ + int zpxpix ( /* Inverse transform (world to physical) */ + double xpos, /* Right ascension */ + double ypos, /* Declination */ + struct WorldCoor *wcs, /* Pointer to WCS descriptor */ + double *xpix, /* Image X coordinate (returned) */ + double *ypix); /* Image Y coordinate (returned) */ + +#else /* K&R prototypes */ + +/* WCS subroutines in wcs.c */ +struct WorldCoor *wcsinit(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsninit(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsinitn(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsninitn(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsinitc(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsninitc(); /* set up a WCS structure from a FITS image header */ +struct WorldCoor *wcsxinit(); /* set up a WCS structure from arguments */ +struct WorldCoor *wcskinit(); /* set up a WCS structure from keyword values */ +char *uppercase(); /* Convert string of any case to uppercase */ +void wcsfree(void); /* Free a WCS structure and its contents */ +int wcstype(); /* Set projection type from header CTYPEs */ +void wcscdset(); /* Set scaling and rotation from CD matrix */ +void wcsdeltset(); /* set scaling and rotation from CDELTs and CROTA2 */ +void wcspcset(); /* set scaling and rotation from CDELTs and PC matrix */ +int iswcs(); /* Return 1 if WCS structure is filled, else 0 */ +int nowcs(); /* Return 0 if WCS structure is filled, else 1 */ +void wcsshift(); /* Reset the center of a WCS structure */ +void wcscent(); /* Print the image center and size in WCS units */ +void wcssize(); /* Return RA and Dec of image center, size in RA and Dec */ +void wcsfull(); /* Return RA and Dec of image center, size in degrees */ +void wcsrange(); /* Return min and max RA and Dec of image in degrees */ +double wcsdist(); /* Distance in degrees between two sky coordinates */ +double wcsdist1(); /* Compute angular distance between 2 sky positions */ +double wcsdiff(); /* Distance in degrees between two sky coordinates */ +void wcscominit(); /* Initialize catalog search command set by -wcscom */ +void wcscom(); /* Execute catalog search command set by -wcscom */ +char *getradecsys(); /* Return current value of coordinate system */ +void wcsoutinit(); /* Initialize WCS output coordinate system for use by pix2wcs */ +char *getwcsout(); /* Return current value of WCS output coordinate system */ +void wcsininit(); /* Initialize WCS input coordinate system for use by wcs2pix */ +char *getwcsin(); /* Return current value of WCS input coordinate system */ +int setwcsdeg(); /* Set WCS output in degrees (1) or hh:mm:ss dd:mm:ss (0) */ +int wcsndec(); /* Set or get number of output decimal places */ +int wcsreset(); /* Change WCS using arguments */ +void wcseqset(); /* Change equinox of reference pixel coordinates in WCS */ +void wcscstr(); /* Return system string from system code, equinox, epoch */ +void setwcslin(); /* Set output string mode for LINEAR coordinates */ +int pix2wcst(); /* Convert pixel coordinates to World Coordinate string */ +void pix2wcs(); /* Convert pixel coordinates to World Coordinates */ +void wcsc2pix(); /* Convert World Coordinates to pixel coordinates */ +void wcs2pix(); /* Convert World Coordinates to pixel coordinates */ +void setdefwcs(); /* Call to use AIPS classic WCS (also not PLT/TNX/ZPX */ +int getdefwcs(); /* Call to get flag for AIPS classic WCS */ +int wcszin(); /* Set coordinate in third dimension (face) */ +int wcszout(); /* Return coordinate in third dimension */ +void wcserr(); /* Print WCS error message to stderr */ +void setwcserr(); /* Set WCS error message for later printing */ +void savewcscoor(); /* Save output coordinate system */ +char *getwcscoor(); /* Return output coordinate system */ +void savewcscom(); /* Save WCS shell command */ +char *getwcscom(); /* Return WCS shell command */ +void setwcscom(); /* Set WCS shell commands from stored values */ +void freewcscom(); /* Free memory used to store WCS shell commands */ +void setwcsfile(); /* Set filename for WCS error message */ +int cpwcs(); /* Copy WCS keywords with no suffix to ones with suffix */ + +/* Coordinate conversion subroutines in wcscon.c */ +void wcscon(); /* Convert between coordinate systems and equinoxes */ +void wcsconp(); /* Convert between coordinate systems and equinoxes */ +void wcsconv(); /* Convert between coordinate systems and equinoxes */ +void fk425e(); /* Convert B1950(FK4) to J2000(FK5) coordinates */ +void fk524e(); /* Convert J2000(FK5) to B1950(FK4) coordinates */ +int wcscsys(); /* Set coordinate system from string */ +double wcsceq(); /* Set equinox from string (return 0.0 if not obvious) */ +void d2v3(); /* Convert RA and Dec in degrees and distance to vector */ +void s2v3(); /* Convert RA and Dec in radians and distance to vector */ +void v2d3(); /* Convert vector to RA and Dec in degrees and distance */ +void v2s3(); /* Convert vector to RA and Dec in radians and distance */ + +/* Distortion model subroutines in distort.c */ +void distortinit(); /* Set distortion coefficients from FITS header */ +void setdistcode(); /* Set WCS distortion code string from CTYPEi value */ +char *getdistcode(); /* Return distortion code string for CTYPEi */ +int DelDistort(); /* Delete all distortion-related fields */ +void pix2foc(); /* pixel coordinates -> focal plane coordinates */ +void foc2pix(); /* focal plane coordinates -> pixel coordinates */ + +/* Other projection subroutines */ + +/* 8 projections using AIPS algorithms (worldpos.c) */ +extern int worldpos(); /* Convert from pixel location to RA,Dec */ +extern int worldpix(); /* Convert from RA,Dec to pixel location */ + +/* Digital Sky Survey projection (dsspos.c) */ +extern int dsspos(); /* Convert from pixel location to RA,Dec */ +extern int dsspix(); /* Convert from RA,Dec to pixel location */ + +/* SAO TDC TAN projection with higher order terms (platepos.c) */ +extern int platepos(); /* Convert from pixel location to RA,Dec */ +extern int platepix(); /* Convert from RA,Dec to pixel location */ +extern void SetFITSPlate(); /* Set FITS header plate fit coefficients from structure */ +extern int SetPlate(); /* Set plate fit coefficients in structure from arguments */ +extern int GetPlate(); /* Return plate fit coefficients from structure in arguments */ + +/* IRAF TAN projection with higher order terms (tnxpos.c) */ +extern int tnxinit(); /* initialize the gnomonic forward or inverse transform */ +extern int tnxpos(); /* forward transform (physical to world) gnomonic projection. */ +extern int tnxpix(); /* Inverse transform (world to physical) gnomonic projection */ + +/* IRAF ZPN projection with higher order terms (zpxpos.c) */ +extern int zpxinit(); /* initialize the gnomonic forward or inverse transform */ +extern int zpxpos(); /* forward transform (physical to world) gnomonic projection. */ +extern int zpxpix(); /* Inverse transform (world to physical) gnomonic projection */ + +#endif /* __STDC__ */ + +#ifdef __cplusplus +} +#endif + +#endif /* _wcs_h_ */ + +/* Oct 26 1994 New file + * Dec 21 1994 Add rotation matrix + * Dec 22 1994 Add flag for coordinate reversal + + * Mar 6 1995 Add parameters for Digital Sky Survey plate fit + * Jun 8 1995 Add parameters for coordinate system change + * Jun 21 1995 Add parameter for plate scale + * Jul 6 1995 Add parameter to note whether WCS is set + * Aug 8 1995 Add parameter to note whether to print coordinate system + * Oct 16 1995 Add parameters to save image dimensions and center coordinates + + * Feb 15 1996 Add coordinate conversion functions + * Feb 20 1996 Add flag for tab tables + * Apr 26 1996 Add epoch of positions (actual date of image) + * Jul 5 1996 Add subroutine declarations + * Jul 19 1996 Add WCSFULL declaration + * Aug 5 1996 Add WCSNINIT to initialize WCS for non-terminated header + * Oct 31 1996 Add DCnn inverse rotation matrix + * Nov 1 1996 Add NDEC number of decimal places in output + * + * May 22 1997 Change range of pcode from 1-8 to -1-8 for linear transform + * Sep 12 1997 Add chip rotation MROT, XMPIX, YMPIX + * + * Jan 7 1998 Add INSTRUME and DETECTOR for HST metric correction + * Jan 16 1998 Add Mark Calabretta's WCSLIB data structures + * Jan 16 1998 Add LONGPOLE, LATPOLE, and PROJP constants for Calabretta + * Jan 22 1998 Add ctype[], crpix[], crval[], and cdelt[] for Calabretta + * Jan 23 1998 Change wcsset() to wcsxinit() and pcode to prjcode + * Jan 23 1998 Define projection type flags + * Jan 26 1998 Remove chip rotation + * Jan 26 1998 Add chip correction polynomial + * Feb 3 1998 Add number of coefficients for residual fit + * Feb 5 1998 Make cd and dc matrices vectors, not individual elements + * Feb 19 1998 Add projection names + * Feb 23 1998 Add TNX projection from NOAO + * Mar 3 1998 Add NOAO plate fit and residual fit + * Mar 12 1998 Add variables for TNX correction surface + * Mar 23 1998 Add PLT plate fit polynomial projection; reassign DSS + * Mar 23 1998 Drop plate_fit flag from structure + * Mar 25 1998 Add npcoeff to wcs structure for new plate fit WCS + * Apr 7 1998 Change amd_i_coeff to i_coeff + * Apr 8 1998 Add wcseqset() and wcsreset() subroutine declarations + * Apr 10 1998 Rearrange order of nonstandard WCS types + * Apr 13 1998 Add setdefwcs() subroutine declaration + * Apr 14 1998 Add coordinate systems and wcscoor() + * Apr 24 1998 Add units + * Apr 28 1998 Change coordinate system flags to WCS_* + * Apr 28 1998 Change projection flags to WCS_* + * Apr 28 1998 Add wcsc2pix() + * May 7 1998 Add C++ declarations + * May 13 1998 Add eqin and eqout for conversions to and from equinoxes + * May 14 1998 Add declarations for coordinate conversion subroutines + * May 27 1998 Add blsearch() + * May 27 1998 Change linear projection back to WCS_LIN from WCS_LPR + * May 27 1998 Move hget.c and hput.c C++ declarations to fitshead.h + * May 27 1998 Include fitshead.h + * May 29 1998 Add wcskinit() + * Jun 1 1998 Add wcserr() + * Jun 11 1998 Add initialization support subroutines + * Jun 18 1998 Add wcspcset() + * Jun 25 1998 Add wcsndec() + * Jul 6 1998 Add wcszin() and wcszout() to use third dimension of images + * Jul 7 1998 Change setdegout() to setwcsdeg(); setlinmode() to setwcslin() + * Jul 17 1998 Add savewcscoor(), getwcscoor(), savewcscom(), and getwcscom() + * Aug 14 1998 Add freewcscom(), setwcscom(), and multiple WCS commands + * Sep 3 1998 Add pa_north, pa_east, imrot and imflip to wcs structure + * Sep 14 1998 Add latbase for AXAF North Polar angle (NPOL not LAT-) + * Sep 16 1998 Make WCS_system start at 1; add NPOLE + * Sep 17 1998 Add wcscstr() + * Sep 21 1998 Add wcsconp() to convert proper motions, too. + * Dec 2 1998 Add WCS type for planet surface + + * Jan 20 1999 Add declaration of wcsfree() + * Jun 16 1999 Add declaration of wcsrange() + * Oct 21 1999 Add declaration of setwcsfile() + * + * Jan 28 2000 Add flags for choice of WCS projection subroutines + * Jun 26 2000 Add XY coordinate system + * Nov 2 2000 Add wcsconv() to convert coordinates when parallax or rv known + * + * Jan 17 2001 Add idpix and ndpix for trim section, ltm for readout rotation + * Jan 31 2001 Add wcsinitn(), wcsninitn(), wcsinitc(), and wcsninitc() + * Feb 20 2001 Add wcs->wcs to main data structure + * Mar 20 2001 Close unclosed comment in wcsconv() argument list + * + * Apr 3 2002 Add SZP and second GLS/SFL projection + * Apr 9 2002 Add wcs->wcsdep for pointer to WCS depending on this WCS + * Apr 26 2002 Add wcs->wcsname and wcs->wcschar to identify WCS structure + * May 9 2002 Add wcs->radvel and wcs->zvel for radial velocity in km/sec + * + * Apr 1 2003 Add wcs->distort Distort structure for distortion correction + * Apr 1 2003 Add foc2pix() and pix2foc() subroutines for distortion correction + * May 1 2003 Add missing semicolons after C++ declarations of previous two functions + * Oct 1 2003 Rename wcs->naxes to wcs->naxis to match WCSLIB 3.2 + * Nov 3 2003 Add distinit(), setdistcode(), and getdistcode() to distort.c + * Dec 3 2003 Add back wcs->naxes for backward compatibility + * + * Aug 30 2004 Add DelDistort() + * + * Nov 1 2005 Add WCS_ICRS + * + * Jan 5 2006 Add secrad() + * Apr 21 2006 Increase maximum number of axes from 4 to 8 + * Apr 24 2006 Increase maximum number of axes to 9 + * Nov 29 2006 Drop semicolon at end of C++ ifdef + * Dec 21 2006 Add cpwcs() + * + * Jan 4 2007 Drop extra declaration of wcscstr() + * Jan 4 2007 Fix declarations so ANSI prototypes are not just for C++ + * Jan 9 2007 Add fk425e() and fk524e() subroutines + * Jan 9 2007 Add worldpos.c, dsspos.c, platepos.c, and tnxpos.c subroutines + * Jan 10 2007 Add ANSI prototypes for all subroutines + * Feb 1 2007 Add wcs.wcslog for log wavelength + * Jul 25 2007 Add v2s3(), s2v3(), d2v3(), v2d3() for coordinate-vector conversion + * + * Mar 31 2010 Add wcsdist1(), an alternate method + * Apr 07 2010 Add NWCSTYPE to keep it aligned with actual number of WCS types + * + * Mar 11 2011 Add NOAO ZPX projection parameters and subroutines (Frank Valdes) + * Mar 14 2011 Add SCAMP polynomial projection coefficients + * Sep 1 2011 Add TPV TAN projectioin with SCAT PV terms + * Sep 9 2011 Fix comment on TPV declaration + * + * Feb 1 2013 Add uppercase() from wcsinit() + * Feb 25 2013 Pass const string to uppercase() + */ diff --git a/tksao/wcssubs/wcscon.c b/tksao/wcssubs/wcscon.c new file mode 100644 index 0000000..6e99bd3 --- /dev/null +++ b/tksao/wcssubs/wcscon.c @@ -0,0 +1,2328 @@ +/*** File wcscon.c + *** March 30, 2010 + *** Doug Mink, Harvard-Smithsonian Center for Astrophysics + *** Some subroutines are based on Starlink subroutines by Patrick Wallace + *** Copyright (C) 1995-2010 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: wcscon.c (World Coordinate System conversion) + * Purpose: Convert between various sky coordinate systems + * Subroutine: wcscon (sys1,sys2,eq1,eq2,theta,phi,epoch) + * convert between coordinate systems + * Subroutine: wcsconp (sys1,sys2,eq1,eq2,ep1,ep2,dtheta,dphi,ptheta,pphi) + * convert coordinates and proper motion between coordinate systems + * Subroutine: wcsconv (sys1,sys2,eq1,eq2,ep1,ep2,dtheta,dphi,ptheta,pphi,px,rv) + * convert coordinates and proper motion between coordinate systems + * Subroutine: wcscsys (cstring) returns code for coordinate system in string + * Subroutine: wcsceq (wcstring) returns equinox in years from system string + * Subroutine: wcscstr (sys,equinox,epoch) returns system string from equinox + * Subroutine: fk524 (ra,dec) Convert J2000(FK5) to B1950(FK4) coordinates + * Subroutine: fk524e (ra, dec, epoch) (more accurate for known position epoch) + * Subroutine: fk524m (ra,dec,rapm,decpm) exact + * Subroutine: fk524pv (ra,dec,rapm,decpm,parallax,rv) more exact + * Subroutine: fk425 (ra,dec) Convert B1950(FK4) to J2000(FK5) coordinates + * Subroutine: fk425e (ra, dec, epoch) (more accurate for known position epoch) + * Subroutine: fk425m (ra, dec, rapm, decpm) exact + * Subroutine: fk425pv (ra,dec,rapm,decpm,parallax,rv) more exact + * Subroutine: fk42gal (dtheta,dphi) Convert B1950(FK4) to galactic coordinates + * Subroutine: fk52gal (dtheta,dphi) Convert J2000(FK5) to galactic coordinates + * Subroutine: gal2fk4 (dtheta,dphi) Convert galactic coordinates to B1950(FK4) + * Subroutine: gal2fk5 (dtheta,dphi) Convert galactic coordinates to J2000<FK5) + * Subroutine: fk42ecl (dtheta,dphi,epoch) Convert B1950(FK4) to ecliptic coordinates + * Subroutine: fk52ecl (dtheta,dphi,epoch) Convert J2000(FK5) to ecliptic coordinates + * Subroutine: ecl2fk4 (dtheta,dphi,epoch) Convert ecliptic coordinates to B1950(FK4) + * Subroutine: ecl2fk5 (dtheta,dphi,epoch) Convert ecliptic coordinates to J2000<FK5) + * Subroutine: fk5prec (ep0, ep1, ra, dec) Precession ep0 to ep1, FK5 system + * Subroutine: fk4prec (ep0, ep1, ra, dec) Precession ep0 to ep1, FK4 system + * Subroutine: d2v3 (rra, rdec, r, pos) RA and Dec in degrees, Distance to Cartesian + * Subroutine: v2d3 (pos, rra, rdec, r) Cartesian to RA and Dec in degrees, Distance + * Subroutine: s2v3 (rra, rdec, r, pos) RA, Dec, Distance to Cartesian + * Subroutine: v2s3 (pos, rra, rdec, r) Cartesian to RA, Dec, Distance + * Subroutine: rotmat (axes, rot1, rot2, rot3, matrix) Rotation angles to matrix + * + * Note: Proper motions are always in RA/Dec degrees/year; no cos(Dec) correction + */ + +#include <math.h> +#ifndef VMS +#include <stdlib.h> +#endif +#include <stdio.h> /* for fprintf() and sprintf() */ +#include <ctype.h> +#include <string.h> +#include "wcs.h" + +void fk524(), fk524e(), fk524m(), fk524pv(); +void fk425(), fk425e(), fk425m(), fk425pv(); +void fk42gal(), fk52gal(), gal2fk4(), gal2fk5(); +void fk42ecl(), fk52ecl(), ecl2fk4(), ecl2fk5(); + +/* Convert from coordinate system sys1 to coordinate system sys2, converting + proper motions, too, and adding them if an epoch is specified */ + +void +wcsconp (sys1, sys2, eq1, eq2, ep1, ep2, dtheta, dphi, ptheta, pphi) + +int sys1; /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +int sys2; /* Output coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +double eq1; /* Input equinox (default of sys1 if 0.0) */ +double eq2; /* Output equinox (default of sys2 if 0.0) */ +double ep1; /* Input Besselian epoch in years (for proper motion) */ +double ep2; /* Output Besselian epoch in years (for proper motion) */ +double *dtheta; /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ +double *dphi; /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ +double *ptheta; /* Longitude or right ascension proper motion in RA degrees/year + Input in sys1, returned in sys2 */ +double *pphi; /* Latitude or declination proper motion in Dec degrees/year + Input in sys1, returned in sys2 */ + +{ + void fk5prec(), fk4prec(); + + /* Set equinoxes if 0.0 */ + if (eq1 == 0.0) { + if (sys1 == WCS_B1950) + eq1 = 1950.0; + else + eq1 = 2000.0; + } + if (eq2 == 0.0) { + if (sys2 == WCS_B1950) + eq2 = 1950.0; + else + eq2 = 2000.0; + } + + /* Set epochs if 0.0 */ + if (ep1 == 0.0) { + if (sys1 == WCS_B1950) + ep1 = 1950.0; + else + ep1 = 2000.0; + } + if (ep2 == 0.0) { + if (sys2 == WCS_B1950) + ep2 = 1950.0; + else + ep2 = 2000.0; + } + + if (sys1 == WCS_ICRS && sys2 == WCS_ICRS) + eq2 = eq1; + + if (sys1 == WCS_J2000 && sys2 == WCS_ICRS && eq1 == 2000.0) { + eq2 = eq1; + sys1 = sys2; + } + + /* Set systems and equinoxes so that ICRS coordinates are not precessed */ + if (sys1 == WCS_ICRS && sys2 == WCS_J2000 && eq2 == 2000.0) { + eq1 = eq2; + sys1 = sys2; + } + + /* If systems and equinoxes are the same, add proper motion and return */ + if (sys2 == sys1 && eq1 == eq2) { + if (ep1 != ep2) { + if (sys1 == WCS_J2000) { + *dtheta = *dtheta + ((ep2 - ep1) * *ptheta); + *dphi = *dphi + ((ep2 - ep1) * *pphi); + } + else if (sys1 == WCS_B1950) { + *dtheta = *dtheta + ((ep2 - ep1) * *ptheta); + *dphi = *dphi + ((ep2 - ep1) * *pphi); + } + } + if (eq1 != eq2) { + if (sys1 == WCS_B1950) + fk4prec (eq1, eq2, dtheta, dphi); + if (sys1 == WCS_J2000) + fk5prec (eq1, 2000.0, dtheta, dphi); + } + return; + } + + /* Precess from input equinox to input system equinox, if necessary */ + if (sys1 == WCS_B1950 && eq1 != 1950.0) + fk4prec (eq1, 1950.0, dtheta, dphi); + if (sys1 == WCS_J2000 && eq1 != 2000.0) + fk5prec (eq1, 2000.0, dtheta, dphi); + + /* Convert to B1950 FK4 */ + if (sys2 == WCS_B1950) { + if (sys1 == WCS_J2000) { + if (*ptheta != 0.0 || *pphi != 0.0) { + fk524m (dtheta, dphi, ptheta, pphi); + if (ep2 != 1950.0) { + *dtheta = *dtheta + ((ep2 - 1950.0) * *ptheta); + *dphi = *dphi + ((ep2 - 1950.0) * *pphi); + } + } + else if (ep2 != 1950.0) + fk524e (dtheta, dphi, ep2); + else + fk524 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk4 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) + ecl2fk4 (dtheta, dphi, ep2); + } + + else if (sys2 == WCS_J2000) { + if (sys1 == WCS_B1950) { + if (*ptheta != 0.0 || *pphi != 0.0) { + fk425m (dtheta, dphi, ptheta, pphi); + if (ep2 != 2000.0) { + *dtheta = *dtheta + ((ep2 - 2000.0) * *ptheta); + *dphi = *dphi + ((ep2 - 2000.0) * *pphi); + } + } + else if (ep2 > 0.0) + fk425e (dtheta, dphi, ep2); + else + fk425 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk5 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) + ecl2fk5 (dtheta, dphi, ep2); + } + + else if (sys2 == WCS_GALACTIC) { + if (sys1 == WCS_B1950) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk42gal (dtheta, dphi); + } + else if (sys1 == WCS_J2000) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk52gal (dtheta, dphi); + } + else if (sys1 == WCS_ECLIPTIC) { + ecl2fk5 (dtheta, dphi, ep2); + fk52gal (dtheta, dphi); + } + } + + else if (sys2 == WCS_ECLIPTIC) { + if (sys1 == WCS_B1950) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + if (ep2 > 0.0) + fk42ecl (dtheta, dphi, ep2); + else + fk42ecl (dtheta, dphi, 1950.0); + } + else if (sys1 == WCS_J2000) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk52ecl (dtheta, dphi, ep2); + } + else if (sys1 == WCS_GALACTIC) { + gal2fk5 (dtheta, dphi); + fk52ecl (dtheta, dphi, ep2); + } + } + + /* Precess to desired equinox, if necessary */ + if (sys2 == WCS_B1950 && eq2 != 1950.0) + fk4prec (1950.0, eq2, dtheta, dphi); + if (sys2 == WCS_J2000 && eq2 != 2000.0) + fk5prec (2000.0, eq2, dtheta, dphi); + + /* Keep latitude/declination between +90 and -90 degrees */ + if (*dphi > 90.0) { + *dphi = 180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + else if (*dphi < -90.0) { + *dphi = -180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + + /* Keep longitude/right ascension between 0 and 360 degrees */ + if (*dtheta > 360.0) + *dtheta = *dtheta - 360.0; + else if (*dtheta < 0.0) + *dtheta = *dtheta + 360.0; + return; +} + + +/* Convert from coordinate system sys1 to coordinate system sys2, converting + proper motions, too, and adding them if an epoch is specified */ + +void +wcsconv (sys1, sys2, eq1, eq2, ep1, ep2, dtheta, dphi, ptheta, pphi, px, rv) + +int sys1; /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +int sys2; /* Output coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +double eq1; /* Input equinox (default of sys1 if 0.0) */ +double eq2; /* Output equinox (default of sys2 if 0.0) */ +double ep1; /* Input Besselian epoch in years (for proper motion) */ +double ep2; /* Output Besselian epoch in years (for proper motion) */ +double *dtheta; /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ +double *dphi; /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ +double *ptheta; /* Longitude or right ascension proper motion in degrees/year + Input in sys1, returned in sys2 */ +double *pphi; /* Latitude or declination proper motion in degrees/year + Input in sys1, returned in sys2 */ +double *px; /* Parallax in arcseconds */ +double *rv; /* Radial velocity in km/sec */ + +{ + void fk5prec(), fk4prec(); + + /* Set equinoxes if 0.0 */ + if (eq1 == 0.0) { + if (sys1 == WCS_B1950) + eq1 = 1950.0; + else + eq1 = 2000.0; + } + if (eq2 == 0.0) { + if (sys2 == WCS_B1950) + eq2 = 1950.0; + else + eq2 = 2000.0; + } + + /* Set epochs if 0.0 */ + if (ep1 == 0.0) { + if (sys1 == WCS_B1950) + ep1 = 1950.0; + else + ep1 = 2000.0; + } + if (ep2 == 0.0) { + if (sys2 == WCS_B1950) + ep2 = 1950.0; + else + ep2 = 2000.0; + } + + /* Set systems and equinoxes so that ICRS coordinates are not precessed */ + if (sys1 == WCS_ICRS && sys2 == WCS_ICRS) + eq2 = eq1; + + if (sys1 == WCS_J2000 && sys2 == WCS_ICRS && eq1 == 2000.0) { + eq2 = eq1; + sys1 = sys2; + } + + if (sys1 == WCS_ICRS && sys2 == WCS_J2000 && eq2 == 2000.0) { + eq1 = eq2; + sys1 = sys2; + } + + /* If systems and equinoxes are the same, add proper motion and return */ + if (sys2 == sys1 && eq1 == eq2) { + if (ep1 != ep2) { + if (sys1 == WCS_J2000) { + *dtheta = *dtheta + ((ep2 - ep1) * *ptheta); + *dphi = *dphi + ((ep2 - ep1) * *pphi); + } + else if (sys1 == WCS_B1950) { + *dtheta = *dtheta + ((ep2 - ep1) * *ptheta); + *dphi = *dphi + ((ep2 - ep1) * *pphi); + } + } + return; + } + + /* Precess from input equinox to input system equinox, if necessary */ + if (eq1 != eq2) { + if (sys1 == WCS_B1950 && eq1 != 1950.0) + fk4prec (eq1, 1950.0, dtheta, dphi); + if (sys1 == WCS_J2000 && eq1 != 2000.0) + fk5prec (eq1, 2000.0, dtheta, dphi); + } + + /* Convert to B1950 FK4 */ + if (sys2 == WCS_B1950) { + if (sys1 == WCS_J2000) { + if (*ptheta != 0.0 || *pphi != 0.0) { + if (*px != 0.0 || *rv != 0.0) + fk524pv (dtheta, dphi, ptheta, pphi, px, rv); + else + fk524m (dtheta, dphi, ptheta, pphi); + if (ep1 == 2000.0) + ep1 = 1950.0; + if (ep2 != 1950.0) { + *dtheta = *dtheta + ((ep2 - 1950.0) * *ptheta); + *dphi = *dphi + ((ep2 - 1950.0) * *pphi); + } + } + else if (ep2 != 1950.0) + fk524e (dtheta, dphi, ep2); + else + fk524 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk4 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) + ecl2fk4 (dtheta, dphi, ep2); + } + + else if (sys2 == WCS_J2000) { + if (sys1 == WCS_B1950) { + if (*ptheta != 0.0 || *pphi != 0.0) { + if (*px != 0.0 || *rv != 0.0) + fk425pv (dtheta, dphi, ptheta, pphi, px, rv); + else + fk425m (dtheta, dphi, ptheta, pphi); + if (ep2 != 2000.0) { + *dtheta = *dtheta + ((ep2 - 2000.0) * *ptheta); + *dphi = *dphi + ((ep2 - 2000.0) * *pphi); + } + } + else if (ep2 > 0.0) + fk425e (dtheta, dphi, ep2); + else + fk425 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk5 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) + ecl2fk5 (dtheta, dphi, ep2); + } + + else if (sys2 == WCS_GALACTIC) { + if (sys1 == WCS_B1950) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk42gal (dtheta, dphi); + } + else if (sys1 == WCS_J2000) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk52gal (dtheta, dphi); + } + else if (sys1 == WCS_ECLIPTIC) { + ecl2fk5 (dtheta, dphi, ep2); + fk52gal (dtheta, dphi); + } + } + + else if (sys2 == WCS_ECLIPTIC) { + if (sys1 == WCS_B1950) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + if (ep2 > 0.0) + fk42ecl (dtheta, dphi, ep2); + else + fk42ecl (dtheta, dphi, 1950.0); + } + else if (sys1 == WCS_J2000) { + if (ep2 != 0.0 && (*ptheta != 0.0 || *pphi != 0.0)) { + *dtheta = *dtheta + (*ptheta * (ep2 - ep1)); + *dphi = *dphi + (*pphi * (ep2 - ep1)); + } + fk52ecl (dtheta, dphi, ep2); + } + else if (sys1 == WCS_GALACTIC) { + gal2fk5 (dtheta, dphi); + fk52ecl (dtheta, dphi, ep2); + } + } + + /* Precess to desired equinox, if necessary */ + if (eq1 != eq2) { + if (sys2 == WCS_B1950 && eq2 != 1950.0) + fk4prec (1950.0, eq2, dtheta, dphi); + if (sys2 == WCS_J2000 && eq2 != 2000.0) + fk5prec (2000.0, eq2, dtheta, dphi); + } + + /* Keep latitude/declination between +90 and -90 degrees */ + if (*dphi > 90.0) { + *dphi = 180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + else if (*dphi < -90.0) { + *dphi = -180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + + /* Keep longitude/right ascension between 0 and 360 degrees */ + if (*dtheta > 360.0) + *dtheta = *dtheta - 360.0; + else if (*dtheta < 0.0) + *dtheta = *dtheta + 360.0; + return; +} + + +/* Convert from coordinate system sys1 to coordinate system sys2 */ + +void +wcscon (sys1, sys2, eq1, eq2, dtheta, dphi, epoch) + +int sys1; /* Input coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +int sys2; /* Output coordinate system (J2000, B1950, ECLIPTIC, GALACTIC */ +double eq1; /* Input equinox (default of sys1 if 0.0) */ +double eq2; /* Output equinox (default of sys2 if 0.0) */ +double *dtheta; /* Longitude or right ascension in degrees + Input in sys1, returned in sys2 */ +double *dphi; /* Latitude or declination in degrees + Input in sys1, returned in sys2 */ +double epoch; /* Besselian epoch in years */ + +{ + void fk5prec(), fk4prec(); + + /* Set equinoxes if 0.0 */ + if (eq1 == 0.0) { + if (sys1 == WCS_B1950) + eq1 = 1950.0; + else + eq1 = 2000.0; + } + if (eq2 == 0.0) { + if (sys2 == WCS_B1950) + eq2 = 1950.0; + else + eq2 = 2000.0; + } + + /* Set systems and equinoxes so that ICRS coordinates are not precessed */ + if (sys1 == WCS_ICRS && sys2 == WCS_ICRS) + eq2 = eq1; + + if (sys1 == WCS_J2000 && sys2 == WCS_ICRS && eq1 == 2000.0) { + eq2 = eq1; + sys1 = sys2; + } + + if (sys1 == WCS_ICRS && sys2 == WCS_J2000 && eq2 == 2000.0) { + eq1 = eq2; + sys1 = sys2; + } + + /* If systems and equinoxes are the same, return */ + if (sys2 == sys1 && eq1 == eq2) + return; + + /* Precess from input equinox, if necessary */ + if (eq1 != eq2) { + if (sys1 == WCS_B1950 && eq1 != 1950.0) + fk4prec (eq1, 1950.0, dtheta, dphi); + if (sys1 == WCS_J2000 && eq1 != 2000.0) + fk5prec (eq1, 2000.0, dtheta, dphi); + } + + /* Convert to B1950 FK4 */ + if (sys2 == WCS_B1950) { + if (sys1 == WCS_J2000) { + if (epoch > 0) + fk524e (dtheta, dphi, epoch); + else + fk524 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk4 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) { + if (epoch > 0) + ecl2fk4 (dtheta, dphi, epoch); + else + ecl2fk4 (dtheta, dphi, 1950.0); + } + } + + else if (sys2 == WCS_J2000) { + if (sys1 == WCS_B1950) { + if (epoch > 0) + fk425e (dtheta, dphi, epoch); + else + fk425 (dtheta, dphi); + } + else if (sys1 == WCS_GALACTIC) + gal2fk5 (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) { + if (epoch > 0) + ecl2fk5 (dtheta, dphi, epoch); + else + ecl2fk5 (dtheta, dphi, 2000.0); + } + } + + else if (sys2 == WCS_GALACTIC) { + if (sys1 == WCS_B1950) + fk42gal (dtheta, dphi); + else if (sys1 == WCS_J2000) + fk52gal (dtheta, dphi); + else if (sys1 == WCS_ECLIPTIC) { + if (epoch > 0) + ecl2fk5 (dtheta, dphi, epoch); + else + ecl2fk5 (dtheta, dphi, 2000.0); + fk52gal (dtheta, dphi); + } + } + + else if (sys2 == WCS_ECLIPTIC) { + if (sys1 == WCS_B1950) { + if (epoch > 0) + fk42ecl (dtheta, dphi, epoch); + else + fk42ecl (dtheta, dphi, 1950.0); + } + else if (sys1 == WCS_J2000) { + if (epoch > 0) + fk52ecl (dtheta, dphi, epoch); + else + fk52ecl (dtheta, dphi, 2000.0); + } + else if (sys1 == WCS_GALACTIC) { + gal2fk5 (dtheta, dphi); + if (epoch > 0) + fk52ecl (dtheta, dphi, epoch); + else + fk52ecl (dtheta, dphi, 2000.0); + } + } + + /* Precess to desired equinox, if necessary */ + if (eq1 != eq2) { + if (sys2 == WCS_B1950 && eq2 != 1950.0) + fk4prec (1950.0, eq2, dtheta, dphi); + if (sys2 == WCS_J2000 && eq2 != 2000.0) + fk5prec (2000.0, eq2, dtheta, dphi); + } + + /* Keep latitude/declination between +90 and -90 degrees */ + if (*dphi > 90.0) { + *dphi = 180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + else if (*dphi < -90.0) { + *dphi = -180.0 - *dphi; + *dtheta = *dtheta + 180.0; + } + + /* Keep longitude/right ascension between 0 and 360 degrees */ + if (*dtheta > 360.0) + *dtheta = *dtheta - 360.0; + else if (*dtheta < 0.0) + *dtheta = *dtheta + 360.0; + + return; +} + + +/* Set coordinate system from string */ +int +wcscsys (wcstring) + +char *wcstring; /* Name of coordinate system */ +{ + double equinox; + + if (wcstring[0] == 'J' || wcstring[0] == 'j' || + !strcmp (wcstring,"2000") || !strcmp (wcstring, "2000.0") || + !strcmp (wcstring,"ICRS") || !strcmp (wcstring, "icrs") || + !strncmp (wcstring,"FK5",3) || !strncmp (wcstring, "fk5",3)) + return WCS_J2000; + + if (wcstring[0] == 'B' || wcstring[0] == 'b' || + !strcmp (wcstring,"1950") || !strcmp (wcstring, "1950.0") || + !strncmp (wcstring,"FK4",3) || !strncmp (wcstring, "fk4",3)) + return WCS_B1950; + + else if (wcstring[0] == 'I' || wcstring[0] == 'i' ) + return WCS_ICRS; + + else if (wcstring[0] == 'G' || wcstring[0] == 'g' ) + return WCS_GALACTIC; + + else if (wcstring[0] == 'E' || wcstring[0] == 'e' ) + return WCS_ECLIPTIC; + + else if (wcstring[0] == 'A' || wcstring[0] == 'a' ) + return WCS_ALTAZ; + + else if (wcstring[0] == 'N' || wcstring[0] == 'n' ) + return WCS_NPOLE; + + else if (wcstring[0] == 'L' || wcstring[0] == 'l' ) + return WCS_LINEAR; + + else if (!strncasecmp (wcstring, "pixel", 5)) + return WCS_XY; + + else if (wcstring[0] == 'P' || wcstring[0] == 'p' ) + return WCS_PLANET; + + else if (isnum (wcstring)) { + equinox = atof (wcstring); + if (equinox > 1980.0) + return WCS_J2000; + else if (equinox > 1900.0) + return WCS_B1950; + else + return -1; + } + else + return -1; +} + + +/* Set equinox from string (return 0.0 if not obvious) */ + +double +wcsceq (wcstring) + +char *wcstring; /* Name of coordinate system */ +{ + if (wcstring[0] == 'J' || wcstring[0] == 'j' || + wcstring[0] == 'B' || wcstring[0] == 'b') + return (atof (wcstring+1)); + else if (!strncmp (wcstring, "FK4",3) || + !strncmp (wcstring, "fk4",3)) + return (1950.0); + else if (!strncmp (wcstring, "FK5",3) || + !strncmp (wcstring, "fk5",3)) + return (2000.0); + else if (!strncmp (wcstring, "ICRS",4) || + !strncmp (wcstring, "icrs",4)) + return (2000.0); + else if (wcstring[0] == '1' || wcstring[0] == '2') + return (atof (wcstring)); + else + return (0.0); +} + + +/* Set coordinate system type string from system and equinox */ + +void +wcscstr (cstr, syswcs, equinox, epoch) + +char *cstr; /* Coordinate system string (returned) */ +int syswcs; /* Coordinate system code */ +double equinox; /* Equinox of coordinate system */ +double epoch; /* Epoch of coordinate system */ +{ + + char *estr; + + if (syswcs == WCS_XY) { + strcpy (cstr, "XY"); + return; + } + + /* Try to figure out coordinate system if it is not set */ + if (epoch == 0.0) + epoch = equinox; + if (syswcs < 0) { + if (equinox > 0.0) { + if (equinox == 2000.0) + syswcs = WCS_J2000; + else if (equinox == 1950.0) + syswcs = WCS_B1950; + } + else if (epoch > 0.0) { + if (epoch > 1980.0) { + syswcs = WCS_J2000; + equinox = 2000.0; + } + else { + syswcs = WCS_B1950; + equinox = 1950.0; + } + } + else + syswcs = WCS_J2000; + } + + /* Set coordinate system string from system flag and epoch */ + if (syswcs == WCS_B1950) { + if (epoch == 1950.0 || epoch == 0.0) + strcpy (cstr, "B1950"); + else + sprintf (cstr, "B%7.2f", equinox); + if ((estr = strsrch (cstr,".00")) != NULL) { + estr[0] = (char) 0; + estr[1] = (char) 0; + estr[2] = (char) 0; + } + } + else if (syswcs == WCS_GALACTIC) + strcpy (cstr, "galactic"); + else if (syswcs == WCS_ECLIPTIC) + strcpy (cstr, "ecliptic"); + else if (syswcs == WCS_J2000) { + if (epoch == 2000.0 || epoch == 0.0) + strcpy (cstr, "J2000"); + else + sprintf (cstr, "J%7.2f", equinox); + if ((estr = strsrch (cstr,".00")) != NULL) { + estr[0] = (char) 0; + estr[1] = (char) 0; + estr[2] = (char) 0; + } + } + else if (syswcs == WCS_ICRS) { + strcpy (cstr, "ICRS"); + } + else if (syswcs == WCS_PLANET) { + strcpy (cstr, "PLANET"); + } + else if (syswcs == WCS_LINEAR || syswcs == WCS_XY) { + strcpy (cstr, "LINEAR"); + } + return; +} + + +/* Constant vector and matrix (by columns) + These values were obtained by inverting C.Hohenkerk's forward matrix + (private communication), which agrees with the one given in reference + 2 but which has one additional decimal place. */ + +static double a[3] = {-1.62557e-6, -0.31919e-6, -0.13843e-6}; +static double ad[3] = {1.245e-3, -1.580e-3, -0.659e-3}; +static double d2pi = 6.283185307179586476925287; /* two PI */ +static double tiny = 1.e-30; /* small number to avoid arithmetic problems */ + +/* FK524 convert J2000 FK5 star data to B1950 FK4 + based on Starlink sla_fk524 by P.T.Wallace 27 October 1987 */ + +static double emi[6][6] = { + { 0.9999256795, /* emi[0][0] */ + 0.0111814828, /* emi[0][1] */ + 0.0048590039, /* emi[0][2] */ + -0.00000242389840, /* emi[0][3] */ + -0.00000002710544, /* emi[0][4] */ + -0.00000001177742 }, /* emi[0][5] */ + + { -0.0111814828, /* emi[1][0] */ + 0.9999374849, /* emi[1][1] */ + -0.0000271771, /* emi[1][2] */ + 0.00000002710544, /* emi[1][3] */ + -0.00000242392702, /* emi[1][4] */ + 0.00000000006585 }, /* emi[1][5] */ + + { -0.0048590040, /* emi[2][0] */ + -0.0000271557, /* emi[2][1] */ + 0.9999881946, /* emi[2][2] */ + 0.00000001177742, /* emi[2][3] */ + 0.00000000006585, /* emi[2][4] */ + -0.00000242404995 }, /* emi[2][5] */ + + { -0.000551, /* emi[3][0] */ + 0.238509, /* emi[3][1] */ + -0.435614, /* emi[3][2] */ + 0.99990432, /* emi[3][3] */ + 0.01118145, /* emi[3][4] */ + 0.00485852 }, /* emi[3][5] */ + + { -0.238560, /* emi[4][0] */ + -0.002667, /* emi[4][1] */ + 0.012254, /* emi[4][2] */ + -0.01118145, /* emi[4][3] */ + 0.99991613, /* emi[4][4] */ + -0.00002717 }, /* emi[4][5] */ + + { 0.435730, /* emi[5][0] */ + -0.008541, /* emi[5][1] */ + 0.002117, /* emi[5][2] */ + -0.00485852, /* emi[5][3] */ + -0.00002716, /* emi[5][4] */ + 0.99996684 } /* emi[5][5] */ + }; + +void +fk524 (ra,dec) + +double *ra; /* Right ascension in degrees (J2000 in, B1950 out) */ +double *dec; /* Declination in degrees (J2000 in, B1950 out) */ + +{ + double rapm; /* Proper motion in right ascension */ + double decpm; /* Proper motion in declination */ + /* In: deg/jul.yr. Out: deg/trop.yr. */ + + rapm = (double) 0.0; + decpm = (double) 0.0; + fk524m (ra, dec, &rapm, &decpm); + return; +} + +void +fk524e (ra, dec, epoch) + +double *ra; /* Right ascension in degrees (J2000 in, B1950 out) */ +double *dec; /* Declination in degrees (J2000 in, B1950 out) */ +double epoch; /* Besselian epoch in years */ + +{ + double rapm; /* Proper motion in right ascension */ + double decpm; /* Proper motion in declination */ + /* In: deg/jul.yr. Out: deg/trop.yr. */ + + rapm = (double) 0.0; + decpm = (double) 0.0; + fk524m (ra, dec, &rapm, &decpm); + *ra = *ra + (rapm * (epoch - 1950.0)); + *dec = *dec + (decpm * (epoch - 1950.0)); + return; +} + +void +fk524m (ra,dec,rapm,decpm) + +double *ra; /* Right ascension in degrees (J2000 in, B1950 out) */ +double *dec; /* Declination in degrees (J2000 in, B1950 out) */ +double *rapm; /* Proper motion in right ascension */ +double *decpm; /* Proper motion in declination */ + /* In: ra/dec deg/jul.yr. Out: ra/dec deg/trop.yr. */ + +{ + double parallax = 0.0; + double rv = 0.0; + + fk524pv (ra, dec, rapm, decpm, ¶llax, &rv); + return; +} + + +void +fk524pv (ra,dec,rapm,decpm, parallax, rv) + +double *ra; /* Right ascension in degrees (J2000 in, B1950 out) */ +double *dec; /* Declination in degrees (J2000 in, B1950 out) */ +double *rapm; /* Proper motion in right ascension */ +double *decpm; /* Proper motion in declination + * In: ra/dec degrees/Julian year (not ra*cos(dec)) + * Out: ra/dec degrees/tropical year */ +double *parallax; /* Parallax (arcsec) */ +double *rv; /* Rradial velocity (km/s, +ve = moving away) */ + +/* This routine converts stars from the IAU 1976 FK5 Fricke + system, to the old Bessel-Newcomb FK4 system, using Yallop's + implementation (see ref 2) of a matrix method due to Standish + (see ref 3). The numerical values of ref 2 are used canonically. + + * Conversion from other than Julian epoch 2000.0 to other than Besselian + epoch 1950.0 will require use of the appropriate precession, proper + motion, and e-terms routines before and/or after fk524 is called. + + * In the FK4 catalogue the proper motions of stars within 10 degrees + of the poles do not embody the differential e-term effect and should, + strictly speaking, be handled in a different manner from stars outside + these regions. however, given the general lack of homogeneity of the + star data available for routine astrometry, the difficulties of handling + positions that may have been determined from astrometric fields spanning + the polar and non-polar regions, the likelihood that the differential + e-terms effect was not taken into account when allowing for proper motion + in past astrometry, and the undesirability of a discontinuity in the + algorithm, the decision has been made in this routine to include the + effect of differential e-terms on the proper motions for all stars, + whether polar or not, at epoch 2000, and measuring on the sky rather + than in terms of dra, the errors resulting from this simplification are + less than 1 milliarcsecond in position and 1 milliarcsecond per century + in proper motion. + + References: + + 1 "Mean and apparent place computations in the new IAU System. + I. The transformation of astrometric catalog systems to the + equinox J2000.0." Smith, C.A.; Kaplan, G.H.; Hughes, J.A.; + Seidelmann, P.K.; Yallop, B.D.; Hohenkerk, C.Y. + Astronomical Journal vol. 97, Jan. 1989, p. 265-273. + + 2 "Mean and apparent place computations in the new IAU System. + II. Transformation of mean star places from FK4 B1950.0 to + FK5 J2000.0 using matrices in 6-space." Yallop, B.D.; + Hohenkerk, C.Y.; Smith, C.A.; Kaplan, G.H.; Hughes, J.A.; + Seidelmann, P.K.; Astronomical Journal vol. 97, Jan. 1989, + p. 274-279. + + 3 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to + the Astronomical Almanac", ISBN 0-935702-68-7. + + 4 "Conversion of positions and proper motions from B1950.0 to the + IAU system at J2000.0", Standish, E.M. Astronomy and + Astrophysics, vol. 115, no. 1, Nov. 1982, p. 20-22. + + P.T.Wallace Starlink 19 December 1993 + Doug Mink Smithsonian Astrophysical Observatory 1 November 2000 */ + +{ + double r2000,d2000; /* J2000.0 ra,dec (radians) */ + double r1950,d1950; /* B1950.0 ra,dec (rad) */ + + /* Miscellaneous */ + double ur,ud; + double sr, cr, sd, cd, x, y, z, w, wd; + double v1[6],v2[6]; + double xd,yd,zd; + double rxyz, rxysq, rxy; + double dra,ddec; + int i,j; + int diag = 0; + + /* Constants */ + double zero = (double) 0.0; + double vf = 21.095; /* Km per sec to AU per tropical century */ + /* = 86400 * 36524.2198782 / 149597870 */ + + /* Convert J2000 RA and Dec from degrees to radians */ + r2000 = degrad (*ra); + d2000 = degrad (*dec); + + /* Convert J2000 RA and Dec proper motion from degrees/year to arcsec/tc */ + ur = *rapm * 360000.0; + ud = *decpm * 360000.0; + + /* Spherical to Cartesian */ + sr = sin (r2000); + cr = cos (r2000); + sd = sin (d2000); + cd = cos (d2000); + + x = cr * cd; + y = sr * cd; + z = sd; + + v1[0] = x; + v1[1] = y; + v1[2] = z; + + if (ur != zero || ud != zero) { + v1[3] = -(ur*y) - (cr*sd*ud); + v1[4] = (ur*x) - (sr*sd*ud); + v1[5] = (cd*ud); + } + else { + v1[3] = zero; + v1[4] = zero; + v1[5] = zero; + } + + /* Convert position + velocity vector to bn system */ + for (i = 0; i < 6; i++) { + w = zero; + for (j = 0; j < 6; j++) { + w = w + emi[i][j] * v1[j]; + } + v2[i] = w; + } + + /* Vector components */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + + /* Magnitude of position vector */ + rxyz = sqrt (x*x + y*y + z*z); + + /* Apply e-terms to position */ + w = (x * a[0]) + (y * a[1]) + (z * a[2]); + x = x + (a[0] * rxyz) - (w * x); + y = y + (a[1] * rxyz) - (w * y); + z = z + (a[2] * rxyz) - (w * z); + + /* Recompute magnitude of position vector */ + rxyz = sqrt (x*x + y*y + z*z); + + /* Apply e-terms to position and velocity */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + w = (x * a[0]) + (y * a[1]) + (z * a[2]); + wd = (x * ad[0]) + (y * ad[1]) + (z * ad[2]); + x = x + (a[0] * rxyz) - (w * x); + y = y + (a[1] * rxyz) - (w * y); + z = z + (a[2] * rxyz) - (w * z); + xd = v2[3] + (ad[0] * rxyz) - (wd * x); + yd = v2[4] + (ad[1] * rxyz) - (wd * y); + zd = v2[5] + (ad[2] * rxyz) - (wd * z); + + /* Convert to spherical */ + rxysq = (x * x) + (y * y); + rxy = sqrt (rxysq); + + /* Convert back to spherical coordinates */ + if (x == zero && y == zero) + r1950 = zero; + else { + r1950 = atan2 (y,x); + if (r1950 < zero) + r1950 = r1950 + d2pi; + } + d1950 = atan2 (z,rxy); + + if (rxy > tiny) { + ur = (x*yd - y*xd) / rxysq; + ud = (zd*rxysq - z * (x*xd + y*yd)) / ((rxysq + z*z) * rxy); + } + + if (*parallax > tiny) { + *rv = ((x * xd) + (y * yd) + (z * zd)) / (*parallax * vf * rxyz); + *parallax = *parallax / rxyz; + } + + /* Return results */ + *ra = raddeg (r1950); + *dec = raddeg (d1950); + *rapm = ur / 360000.0; + *decpm = ud / 360000.0; + + if (diag) { + dra = 240.0 * raddeg (r1950 - r2000); + ddec = 3600.0 * raddeg (d1950 - d2000); + fprintf(stderr,"B1950-J2000: dra= %11.5f sec ddec= %f11.5f arcsec\n", + dra, ddec); + } + + return; +} + + +/* Convert B1950.0 FK4 star data to J2000.0 FK5 */ +static double em[6][6] = { + { 0.9999256782, /* em[0][0] */ + -0.0111820611, /* em[0][1] */ + -0.0048579477, /* em[0][2] */ + 0.00000242395018, /* em[0][3] */ + -0.00000002710663, /* em[0][4] */ + -0.00000001177656 }, /* em[0][5] */ + + { 0.0111820610, /* em[1][0] */ + 0.9999374784, /* em[1][1] */ + -0.0000271765, /* em[1][2] */ + 0.00000002710663, /* em[1][3] */ + 0.00000242397878, /* em[1][4] */ + -0.00000000006587 }, /* em[1][5] */ + + { 0.0048579479, /* em[2][0] */ + -0.0000271474, /* em[2][1] */ + 0.9999881997, /* em[2][2] */ + 0.00000001177656, /* em[2][3] */ + -0.00000000006582, /* em[2][4] */ + 0.00000242410173 }, /* em[2][5] */ + + { -0.000551, /* em[3][0] */ + -0.238565, /* em[3][1] */ + 0.435739, /* em[3][2] */ + 0.99994704, /* em[3][3] */ + -0.01118251, /* em[3][4] */ + -0.00485767 }, /* em[3][5] */ + + { 0.238514, /* em[4][0] */ + -0.002667, /* em[4][1] */ + -0.008541, /* em[4][2] */ + 0.01118251, /* em[4][3] */ + 0.99995883, /* em[4][4] */ + -0.00002718 }, /* em[4][5] */ + + { -0.435623, /* em[5][0] */ + 0.012254, /* em[5][1] */ + 0.002117, /* em[5][2] */ + 0.00485767, /* em[5][3] */ + -0.00002714, /* em[5][4] */ + 1.00000956 } /* em[5][5] */ + }; + +void +fk425 (ra, dec) + +double *ra; /* Right ascension in degrees (B1950 in, J2000 out) */ +double *dec; /* Declination in degrees (B1950 in, J2000 out) */ + +{ +double rapm; /* Proper motion in right ascension */ +double decpm; /* Proper motion in declination */ + /* In: rad/trop.yr. Out: rad/jul.yr. */ + + rapm = (double) 0.0; + decpm = (double) 0.0; + fk425m (ra, dec, &rapm, &decpm); + return; +} + + +void +fk425e (ra, dec, epoch) + +double *ra; /* Right ascension in degrees (B1950 in, J2000 out) */ +double *dec; /* Declination in degrees (B1950 in, J2000 out) */ +double epoch; /* Besselian epoch in years */ +{ +double rapm; /* Proper motion in right ascension */ +double decpm; /* Proper motion in declination */ + /* In: rad/trop.yr. Out: rad/jul.yr. */ + + rapm = (double) 0.0; + decpm = (double) 0.0; + fk425m (ra, dec, &rapm, &decpm); + *ra = *ra + (rapm * (epoch - 2000.0)); + *dec = *dec + (decpm * (epoch - 2000.0)); + return; +} + +void +fk425m (ra, dec, rapm, decpm) + +double *ra, *dec; /* Right ascension and declination in degrees + input: B1950.0,FK4 returned: J2000.0,FK5 */ +double *rapm, *decpm; /* Proper motion in right ascension and declination + input: B1950.0,FK4 returned: J2000.0,FK5 + ra/dec deg/trop.yr. ra/dec deg/jul.yr. */ +{ + double parallax = 0.0; + double rv = 0.0; + + fk425pv (ra, dec, rapm, decpm, ¶llax, &rv); + return; +} + + +void +fk425pv (ra,dec,rapm,decpm, parallax, rv) + +double *ra; /* Right ascension in degrees (J2000 in, B1950 out) */ +double *dec; /* Declination in degrees (J2000 in, B1950 out) */ +double *rapm; /* Proper motion in right ascension */ +double *decpm; /* Proper motion in declination + * In: ra/dec degrees/Julian year (not ra*cos(dec)) + * Out: ra/dec degrees/tropical year */ +double *parallax; /* Parallax (arcsec) */ +double *rv; /* Rradial velocity (km/s, +ve = moving away) */ + +/* This routine converts stars from the old Bessel-Newcomb FK4 system + to the IAU 1976 FK5 Fricke system, using Yallop's implementation + (see ref 2) of a matrix method due to Standish (see ref 3). The + numerical values of ref 2 are used canonically. + + * Conversion from other than Besselian epoch 1950.0 to other than Julian + epoch 2000.0 will require use of the appropriate precession, proper + motion, and e-terms routines before and/or after fk425 is called. + + * In the FK4 catalogue the proper motions of stars within 10 degrees + of the poles do not embody the differential e-term effect and should, + strictly speaking, be handled in a different manner from stars outside + these regions. however, given the general lack of homogeneity of the + star data available for routine astrometry, the difficulties of handling + positions that may have been determined from astrometric fields spanning + the polar and non-polar regions, the likelihood that the differential + e-terms effect was not taken into account when allowing for proper motion + in past astrometry, and the undesirability of a discontinuity in the + algorithm, the decision has been made in this routine to include the + effect of differential e-terms on the proper motions for all stars, + whether polar or not, at epoch 2000, and measuring on the sky rather + than in terms of dra, the errors resulting from this simplification are + less than 1 milliarcsecond in position and 1 milliarcsecond per century + in proper motion. + + References: + + 1 "Mean and apparent place computations in the new IAU System. + I. The transformation of astrometric catalog systems to the + equinox J2000.0." Smith, C.A.; Kaplan, G.H.; Hughes, J.A.; + Seidelmann, P.K.; Yallop, B.D.; Hohenkerk, C.Y. + Astronomical Journal vol. 97, Jan. 1989, p. 265-273. + + 2 "Mean and apparent place computations in the new IAU System. + II. Transformation of mean star places from FK4 B1950.0 to + FK5 J2000.0 using matrices in 6-space." Yallop, B.D.; + Hohenkerk, C.Y.; Smith, C.A.; Kaplan, G.H.; Hughes, J.A.; + Seidelmann, P.K.; Astronomical Journal vol. 97, Jan. 1989, + p. 274-279. + + 3 "Conversion of positions and proper motions from B1950.0 to the + IAU system at J2000.0", Standish, E.M. Astronomy and + Astrophysics, vol. 115, no. 1, Nov. 1982, p. 20-22. + + P.T.Wallace Starlink 20 December 1993 + Doug Mink Smithsonian Astrophysical Observatory 7 June 1995 */ + +{ + double r1950,d1950; /* B1950.0 ra,dec (rad) */ + double r2000,d2000; /* J2000.0 ra,dec (rad) */ + + /* Miscellaneous */ + double ur,ud,sr,cr,sd,cd,w,wd; + double x,y,z,xd,yd,zd, dra,ddec; + double rxyz, rxysq, rxy, rxyzsq, spxy, spxyz; + int i,j; + int diag = 0; + + double r0[3],rd0[3]; /* star position and velocity vectors */ + double v1[6],v2[6]; /* combined position and velocity vectors */ + + /* Constants */ + double zero = (double) 0.0; + double vf = 21.095; /* Km per sec to AU per tropical century */ + /* = 86400 * 36524.2198782 / 149597870 */ + + /* Convert B1950 RA and Dec from degrees to radians */ + r1950 = degrad (*ra); + d1950 = degrad (*dec); + + /* Convert B1950 RA and Dec proper motion from degrees/year to arcsec/tc */ + ur = *rapm * 360000.0; + ud = *decpm * 360000.0; + + /* Convert direction to Cartesian */ + sr = sin (r1950); + cr = cos (r1950); + sd = sin (d1950); + cd = cos (d1950); + r0[0] = cr * cd; + r0[1] = sr * cd; + r0[2] = sd; + + /* Convert motion to Cartesian */ + w = vf * *rv * *parallax; + if (ur != zero || ud != zero || (*rv != zero && *parallax != zero)) { + rd0[0] = (-sr * cd * ur) - (cr * sd * ud) + (w * r0[0]); + rd0[1] = (cr * cd * ur) - (sr * sd * ud) + (w * r0[1]); + rd0[2] = (cd * ud) + (w * r0[2]); + } + else { + rd0[0] = zero; + rd0[1] = zero; + rd0[2] = zero; + } + + /* Remove e-terms from position and express as position+velocity 6-vector */ + w = (r0[0] * a[0]) + (r0[1] * a[1]) + (r0[2] * a[2]); + for (i = 0; i < 3; i++) + v1[i] = r0[i] - a[i] + (w * r0[i]); + + /* Remove e-terms from proper motion and express as 6-vector */ + wd = (r0[0] * ad[0]) + (r0[1] * ad[1]) + (r0[2] * ad[2]); + for (i = 0; i < 3; i++) + v1[i+3] = rd0[i] - ad[i] + (wd * r0[i]); + + /* Alternately: Put proper motion in 6-vector without adding e-terms + for (i = 0; i < 3; i++) + v1[i+3] = rd0[i]; */ + + /* Convert position + velocity vector to FK5 system */ + for (i = 0; i < 6; i++) { + w = zero; + for (j = 0; j < 6; j++) { + w += em[i][j] * v1[j]; + } + v2[i] = w; + } + + /* Vector components */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + xd = v2[3]; + yd = v2[4]; + zd = v2[5]; + + /* Magnitude of position vector */ + rxysq = x*x + y*y; + rxy = sqrt (rxysq); + rxyzsq = rxysq + z*z; + rxyz = sqrt (rxyzsq); + + spxy = (x * xd) + (y * yd); + spxyz = spxy + (z * zd); + + /* Convert back to spherical coordinates */ + if (x == zero && y == zero) + r2000 = zero; + else { + r2000 = atan2 (y,x); + if (r2000 < zero) + r2000 = r2000 + d2pi; + } + d2000 = atan2 (z,rxy); + + if (rxy > tiny) { + ur = ((x * yd) - (y * xd)) / rxysq; + ud = ((zd * rxysq) - (z * spxy)) / (rxyzsq * rxy); + } + + if (*parallax > tiny) { + *rv = spxyz / (*parallax * rxyz * vf); + *parallax = *parallax / rxyz; + } + + /* Return results */ + *ra = raddeg (r2000); + *dec = raddeg (d2000); + *rapm = ur / 360000.0; + *decpm = ud / 360000.0; + + if (diag) { + dra = 240.0 * raddeg (r2000 - r1950); + ddec = 3600.0 * raddeg (d2000 - d1950); + fprintf(stderr,"J2000-B1950: dra= %11.5f sec ddec= %f11.5f arcsec\n", + dra, ddec); + } + return; +} + +int idg=0; + +/* l2,b2 system of galactic coordinates + * p = 192.25 ra of galactic north pole (mean b1950.0) + * q = 62.6 inclination of galactic to mean b1950.0 equator + * r = 33 longitude of ascending node + * p,q,r are degrees + + * Equatorial to galactic rotation matrix + (The Eulerian angles are p, q, 90-r) + +cp.cq.sr-sp.cr +sp.cq.sr+cp.cr -sq.sr + -cp.cq.cr-sp.sr -sp.cq.cr+cp.sr +sq.cr + cp.sq +sp.sq +cq + */ + +static +double bgal[3][3] = + {{-0.066988739415,-0.872755765852,-0.483538914632}, + {0.492728466075,-0.450346958020, 0.744584633283}, + {-0.867600811151,-0.188374601723, 0.460199784784}}; + +/*--- Transform B1950.0 FK4 equatorial coordinates to + * IAU 1958 galactic coordinates */ + +void +fk42gal (dtheta,dphi) + +double *dtheta; /* B1950.0 FK4 right ascension in degrees + Galactic longitude (l2) in degrees (returned) */ +double *dphi; /* B1950.0 FK4 declination in degrees + Galactic latitude (b2) in degrees (returned) */ + +/* Input equatorial coordinates are B1950 FK4. + Use fk52gal() to convert from j2000.0 coordinates. + Reference: Blaauw et al, MNRAS,121,123 (1960) */ +{ + double pos[3],pos1[3],r,dl,db,rl,rb,rra,rdec,dra,ddec; + void v2s3(),s2v3(); + int i; + char *eqcoor, *eqstrn(); + + dra = *dtheta; + ddec = *dphi; + rra = degrad (dra); + rdec = degrad (ddec); + + /* remove e-terms */ + /* call jpabe (rra,rdec,-1,idg) */ + + /* Spherical to Cartesian */ + r = 1.; + s2v3 (rra,rdec,r,pos); + + /* rotate to galactic */ + for (i = 0; i<3; i++) { + pos1[i] = pos[0]*bgal[i][0] + pos[1]*bgal[i][1] + pos[2]*bgal[i][2]; + } + + /* Cartesian to spherical */ + v2s3 (pos1,&rl,&rb,&r); + + dl = raddeg (rl); + db = raddeg (rb); + *dtheta = dl; + *dphi = db; + + /* Print result if in diagnostic mode */ + if (idg) { + eqcoor = eqstrn (dra,ddec); + fprintf (stderr,"FK42GAL: B1950 RA,Dec= %s\n",eqcoor); + fprintf (stderr,"FK42GAL: long = %.5f lat = %.5f\n",dl,db); + free (eqcoor); + } + + return; +} + + +/*--- Transform IAU 1958 galactic coordinates to B1950.0 'FK4' + * equatorial coordinates */ + +void +gal2fk4 (dtheta,dphi) + +double *dtheta; /* Galactic longitude (l2) in degrees + B1950 FK4 RA in degrees (returned) */ +double *dphi; /* Galactic latitude (b2) in degrees + B1950 FK4 Dec in degrees (returned) */ + +/* Output equatorial coordinates are B1950.0 FK4. + Use gal2fk5() to convert to J2000 coordinates. + Reference: Blaauw et al, MNRAS,121,123 (1960) */ + +{ + double pos[3],pos1[3],r,dl,db,rl,rb,rra,rdec,dra,ddec; + void v2s3(),s2v3(); + char *eqcoor, *eqstrn(); + int i; + + /* spherical to cartesian */ + dl = *dtheta; + db = *dphi; + rl = degrad (dl); + rb = degrad (db); + r = 1.0; + s2v3 (rl,rb,r,pos); + + /* rotate to equatorial coordinates */ + for (i = 0; i < 3; i++) { + pos1[i] = pos[0]*bgal[0][i] + pos[1]*bgal[1][i] + pos[2]*bgal[2][i]; + } + + /* cartesian to spherical */ + v2s3 (pos1,&rra,&rdec,&r); + +/* introduce e-terms */ +/* jpabe (rra,rdec,-1,idg); */ + + dra = raddeg (rra); + ddec = raddeg (rdec); + *dtheta = dra; + *dphi = ddec; + + /* print result if in diagnostic mode */ + if (idg) { + fprintf (stderr,"GAL2FK4: long = %.5f lat = %.5f\n",dl,db); + eqcoor = eqstrn (dra,ddec); + fprintf (stderr,"GAL2FK4: B1950 RA,Dec= %s\n",eqcoor); + free (eqcoor); + } + + return; +} + + +/* l2,b2 system of galactic coordinates + p = 192.25 ra of galactic north pole (mean b1950.0) + q = 62.6 inclination of galactic to mean b1950.0 equator + r = 33 longitude of ascending node + p,q,r are degrees */ + +/* Equatorial to galactic rotation matrix + The eulerian angles are p, q, 90-r + +cp.cq.sr-sp.cr +sp.cq.sr+cp.cr -sq.sr + -cp.cq.cr-sp.sr -sp.cq.cr+cp.sr +sq.cr + +cp.sq +sp.sq +cq */ + +static +double jgal[3][3] = + {{-0.054875539726,-0.873437108010,-0.483834985808}, + {0.494109453312,-0.444829589425, 0.746982251810}, + {-0.867666135858,-0.198076386122, 0.455983795705}}; + +/* Transform J2000 equatorial coordinates to IAU 1958 galactic coordinates */ + +void +fk52gal (dtheta,dphi) + +double *dtheta; /* J2000 right ascension in degrees + Galactic longitude (l2) in degrees (returned) */ +double *dphi; /* J2000 declination in degrees + Galactic latitude (b2) in degrees (returned) */ + +/* Rotation matrices by P.T.Wallace, Starlink eqgal and galeq, March 1986 */ + +/* Input equatorial coordinates are J2000 FK5. + Use gal2fk4() if converting from B1950 FK4 coordinates. + Reference: Blaauw et al, MNRAS,121,123 (1960) */ +{ + double pos[3],pos1[3],r,dl,db,rl,rb,rra,rdec,dra,ddec; + void v2s3(),s2v3(); + char *eqcoor, *eqstrn(); + int i; + + /* Spherical to cartesian */ + dra = *dtheta; + ddec = *dphi; + rra = degrad (dra); + rdec = degrad (ddec); + r = 1.0; + (void)s2v3 (rra,rdec,r,pos); + + /* Rotate to galactic */ + for (i = 0; i < 3; i++) { + pos1[i] = pos[0]*jgal[i][0] + pos[1]*jgal[i][1] + pos[2]*jgal[i][2]; + } + + /* Cartesian to spherical */ + v2s3 (pos1,&rl,&rb,&r); + + dl = raddeg (rl); + db = raddeg (rb); + *dtheta = dl; + *dphi = db; + + /* Print result if in diagnostic mode */ + if (idg) { + eqcoor = eqstrn (dra,ddec); + fprintf (stderr,"FK52GAL: J2000 RA,Dec= %s\n",eqcoor); + fprintf (stderr,"FK52GAL: long = %.5f lat = %.5f\n",dl,db); + free (eqcoor); + } + + return; +} + + +/*--- Transform IAU 1958 galactic coordinates to J2000 equatorial coordinates */ + +void +gal2fk5 (dtheta,dphi) + +double *dtheta; /* Galactic longitude (l2) in degrees + J2000.0 ra in degrees (returned) */ +double *dphi; /* Galactic latitude (b2) in degrees + J2000.0 dec in degrees (returned) */ + +/* Output equatorial coordinates are J2000. + Use gal2fk4() to convert to B1950 coordinates. + Reference: Blaauw et al, MNRAS,121,123 (1960) */ + +{ + double pos[3],pos1[3],r,dl,db,rl,rb,rra,rdec,dra,ddec; + void v2s3(),s2v3(); + int i; + char *eqcoor, *eqstrn(); + + /* Spherical to Cartesian */ + dl = *dtheta; + db = *dphi; + rl = degrad (dl); + rb = degrad (db); + r = 1.0; + s2v3 (rl,rb,r,pos); + + /* Rotate to equatorial coordinates */ + for (i = 0; i < 3; i++) { + pos1[i] = pos[0]*jgal[0][i] + pos[1]*jgal[1][i] + pos[2]*jgal[2][i]; + } + + /* Cartesian to Spherical */ + v2s3 (pos1,&rra,&rdec,&r); + dra = raddeg (rra); + ddec = raddeg (rdec); + *dtheta = dra; + *dphi = ddec; + + /* Print result if in diagnostic mode */ + if (idg) { + fprintf (stderr,"GAL2FK5: long = %.5f lat = %.5f\n",dl,db); + eqcoor = eqstrn (dra,ddec); + fprintf (stderr,"GAL2FK5: J2000 RA,Dec= %s\n",eqcoor); + free (eqcoor); + } + + return; +} + + +/* Return string with right ascension in hours and declination in degrees */ + +char *eqstrn (dra, ddec) + +double dra; /* Right ascension in degrees */ +double ddec; /* Declination in degrees */ + +{ +char *eqcoor; /* ASCII character string of position (returned) */ +char decp; +int rah,irm,decd,decm; +double xpos,ypos,xp,yp,ras,decs; + + /* Right ascension to hours, minutes, and seconds */ + xpos = dra / 15.0; + rah = (int) xpos; + xp = (double) 60.0 * (xpos - (double) rah); + irm = (int) xp; + ras = (double) 60.0 * (xp - (double) irm); + + /* Declination to degrees, minutes, seconds */ + if (ddec < 0) { + ypos = -ddec; + decp = '-'; + } + else { + decp = '+'; + ypos = ddec; + } + decd = (int) ypos; + yp = (double) 60.0 * (ypos - (double) decd); + decm = (int) yp; + decs = (double) 60.0 * (yp - (double) decm); + + eqcoor = malloc (32); + (void)sprintf (eqcoor,"%02d:%02d:%06.3f %c%02d:%02d:%05.2f", + rah,irm,ras,decp,decd,decm,decs); + if (eqcoor[6] == ' ') + eqcoor[6] = '0'; + if (eqcoor[20] == ' ') + eqcoor[20] = '0'; + + return (eqcoor); +} + + +/* Convert geocentric equatorial rectangular coordinates to + right ascension and declination, and distance */ + + +/* These routines are based on similar ones in Pat Wallace's slalib package */ + +/* Convert B1950 right ascension and declination to ecliptic coordinates */ + +void +fk42ecl (dtheta, dphi, epoch) + +double *dtheta; /* B1950 right ascension in degrees + Galactic longitude (l2) in degrees (returned) */ +double *dphi; /* B1950 declination in degrees + Galactic latitude (b2) in degrees (returned) */ +double epoch; /* Besselian epoch in years */ + +{ + void fk425e(), fk52ecl(); + + /* Convert from B1950 to J2000 coordinates */ + fk425e (dtheta, dphi, epoch); + + /* Convert from J2000 to ecliptic coordinates */ + fk52ecl (dtheta, dphi, epoch); + + return; +} + +/* Convert J2000 right ascension and declination to ecliptic coordinates */ + +void +fk52ecl (dtheta, dphi, epoch) + +double *dtheta; /* J2000 right ascension in degrees + Galactic longitude (l2) in degrees (returned) */ +double *dphi; /* J2000 declination in degrees + Galactic latitude (b2) in degrees (returned) */ +double epoch; /* Besselian epoch in years */ + +{ + int i, j; + double t, eps0, rphi, rtheta; + double v1[3], v2[3], r; + double rmat[9], *rmati; /* Rotation matrix */ + + void rotmat(), v2s3(), s2v3(), fk5prec(); + + /* Precess coordinates from J2000 to epoch */ + if (epoch != 2000.0) + fk5prec (2000.0, epoch, dtheta, dphi); + + /* Convert from degrees to radians */ + rtheta = degrad (*dtheta); + rphi = degrad (*dphi); + + /* Convert RA,Dec to x,y,z */ + r = 1.0; + s2v3 (rtheta, rphi, r, v1); + + /* Interval between basic epoch J2000.0 and current epoch (JC) in centuries*/ + t = (epoch - 2000.0) * 0.01; + + /* Mean obliquity */ + eps0 = secrad ((84381.448 + (-46.8150 + (-0.00059 + 0.001813*t) * t) * t)); + + /* Form the equatorial to ecliptic rotation matrix (IAU 1980 theory). + * References: Murray, C.A., Vectorial Astrometry, section 4.3. + * The matrix is in the sense v[ecl] = rmat * v[equ]; the + * equator, equinox and ecliptic are mean of date. */ + rotmat (1, eps0, 0.0, 0.0, rmat); + + /* Multiply position vector by equatoria to eccliptic rotation matrix */ + rmati = rmat; + for (i = 0; i < 3; i++) { + v2[i] = 0; + for (j = 0; j < 3; j++) + v2[i] = v2[i] + (*rmati++ * v1[j]); + } + + /* Convert x,y,z to latitude, longitude */ + v2s3 (v2, &rtheta, &rphi, &r); + + /* Convert from radians to degrees */ + *dtheta = raddeg (rtheta); + *dphi = raddeg (rphi); +} + + +/* Convert ecliptic coordinates to B1950 right ascension and declination */ + +void +ecl2fk4 (dtheta, dphi, epoch) + +double *dtheta; /* Galactic longitude (l2) in degrees + B1950 right ascension in degrees (returned) */ +double *dphi; /* Galactic latitude (b2) in degrees + B1950 declination in degrees (returned) */ +double epoch; /* Besselian epoch in years */ + +{ + void ecl2fk5(), fk524e(); + + /* Convert from ecliptic to J2000 coordinates */ + ecl2fk5 (dtheta, dphi, epoch); + + /* Convert from J2000 to B1950 coordinates */ + fk524e (dtheta, dphi, epoch); + + return; +} + + + +/* Convert ecliptic coordinates to J2000 right ascension and declination */ + +void +ecl2fk5 (dtheta, dphi, epoch) + +double *dtheta; /* Galactic longitude (l2) in degrees + J2000 right ascension in degrees (returned) */ +double *dphi; /* Galactic latitude (b2) in degrees + J2000 declination in degrees (returned) */ +double epoch; /* Besselian epoch in years */ + +{ + int i, j; + double rtheta, rphi, v1[3], v2[3]; + double t, eps0, r; + double rmat[9]; /* Rotation matrix */ + void v2s3(),s2v3(), fk5prec(), rotmat(); + + rtheta = degrad (*dtheta); + rphi = degrad (*dphi); + + /* Convert RA,Dec to x,y,z */ + r = 1.0; + s2v3 (rtheta, rphi, r, v1); + + /* Interval between basic epoch J2000.0 and current epoch (JC) in centuries*/ + t = (epoch - 2000.0) * 0.01; + + /* Mean obliquity */ + eps0 = secrad ((84381.448 + (-46.8150 + (-0.00059 + 0.001813*t) * t) * t)); + + /* Form the equatorial to ecliptic rotation matrix (IAU 1980 theory). + * References: Murray, C.A., Vectorial Astrometry, section 4.3. + * The matrix is in the sense v[ecl] = rmat * v[equ]; the + * equator, equinox and ecliptic are mean of date. */ + rotmat (1, eps0, 0.0, 0.0, rmat); + + /* Multiply position vector by ecliptic to equatorial rotation matrix */ + for (i = 0; i < 3; i++) { + v2[i] = 0; + for (j = 0; j < 3; j++) + v2[i] = v2[i] + (rmat[3*j + i] * v1[j]); + } + + /* Cartesian to spherical */ + v2s3 (v2, &rtheta, &rphi, &r); + + /* Convert from radians to degrees */ + *dtheta = raddeg (rtheta); + *dphi = raddeg (rphi); + + if (epoch != 2000.0) + fk5prec (epoch, 2000.0, dtheta, dphi); +} + + +/* The following routines are modified from Patrick Wallace's SLALIB */ + +/* Precess coordinates between epochs in FK4 */ +void +fk4prec (ep0, ep1, ra, dec) + +double ep0; /* Starting Besselian epoch */ +double ep1; /* Ending Besselian epoch */ +double *ra; /* RA in degrees mean equator & equinox of epoch ep0 + mean equator & equinox of epoch ep1 (returned) */ +double *dec; /* Dec in degrees mean equator & equinox of epoch ep0 + mean equator & equinox of epoch ep1 (returned) */ +/* +** Precession - FK4 (Bessel-Newcomb, pre-IAU1976) +** +** This routine will not correctly convert between FK4 and FK5 +** For output in FK5, precess to 1950.0 and use fk425() on result. +** +** Based on slaPreces(), P.T.Wallace Starlink 22 December 1993 +*/ +{ + int i, j; + double pm[9], *pmi, v1[3], v2[3], rra, rdec, r; + void v2s3(),s2v3(), mprecfk4(); + + rra = degrad (*ra); + rdec = degrad (*dec); + r = 1.0; + + /* Generate appropriate precession matrix */ + mprecfk4 ( ep0, ep1, pm ); + + /* Convert RA,Dec to x,y,z */ + s2v3 (rra, rdec, r, v1); + + /* Multiply position vector by precession matrix */ + pmi = pm; + for (i = 0; i < 3; i++) { + v2[i] = 0; + for (j = 0; j < 3; j++) + v2[i] = v2[i] + (*pmi++ * v1[j]); + } + + /* Back to RA,Dec */ + v2s3 (v2, &rra, &rdec, &r); + + /* Convert from radians to degrees */ + *ra = raddeg (rra); + *dec = raddeg (rdec); +} + +void +fk5prec (ep0, ep1, ra, dec) + +double ep0; /* Starting epoch */ +double ep1; /* Ending epoch */ +double *ra; /* RA in degrees mean equator & equinox of epoch ep0 + mean equator & equinox of epoch ep1 (returned) */ +double *dec; /* Dec in degrees mean equator & equinox of epoch ep0 + mean equator & equinox of epoch ep1 (returned) */ +/* +** Precession - FK5 (Fricke, post-IAU1976) +** +** This routine will not correctly convert between FK5 and FK4. +** For output in FK4, precess to 2000.0 and use fk524() on result. +** +** Based on slaPreces(), P.T.Wallace Starlink 22 December 1993 +*/ +{ + int i, j; + double pm[9], *pmi, v1[3], v2[3], rra, rdec, r; + void v2s3(),s2v3(), mprecfk5(); + + rra = degrad (*ra); + rdec = degrad (*dec); + r = 1.0; + + /* Generate appropriate precession matrix */ + mprecfk5 (ep0, ep1, pm); + + /* Convert RA,Dec to x,y,z */ + s2v3 (rra, rdec, r, v1); + + /* Multiply position vector by precession matrix */ + pmi = pm; + for (i = 0; i < 3; i++) { + v2[i] = 0; + for (j = 0; j < 3; j++) + v2[i] = v2[i] + ( v1[j] * *pmi++ ); + } + + /* Back to RA,Dec */ + v2s3 (v2, &rra, &rdec, &r); + + /* Convert from radians to degrees */ + *ra = raddeg (rra); + *dec = raddeg (rdec); + return; +} + + +void +mprecfk4 (bep0, bep1, rmatp) + +double bep0; /* Beginning Besselian epoch */ +double bep1; /* Ending Besselian epoch */ +double rmatp[9]; /* 3x3 Precession matrix (returned) */ + +/* +** Generate the matrix of precession between two epochs, +** using the old, pre-IAU1976, Bessel-Newcomb model, using +** Kinoshita's formulation (double precision) +** +** The matrix is in the sense v(bep1) = rmatp * v(bep0) +** +** Reference: +** Kinoshita, H. (1975) 'Formulas for precession', SAO Special +** Report No. 364, Smithsonian Institution Astrophysical +** Observatory, Cambridge, Massachusetts. +** +** Based on slaPrebn() by P.T.Wallace Starlink 30 October 1993 +*/ +{ + double bigt, t, tas2r, w, zeta, z, theta; + void rotmat(); + + /* Interval between basic epoch B1850.0 and beginning epoch in TC */ + bigt = ( bep0 - 1850.0 ) / 100.0; + + /* Interval over which precession required, in tropical centuries */ + t = ( bep1 - bep0 ) / 100.0; + + /* Euler angles */ + tas2r = secrad (t); + w = 2303.5548 + ( 1.39720 + 0.000059 * bigt ) * bigt; + zeta = (w + ( 0.30242 - 0.000269 * bigt + 0.017996 * t ) * t ) * tas2r; + z = (w + ( 1.09478 + 0.000387 * bigt + 0.018324 * t ) * t ) * tas2r; + theta = ( 2005.1125 + ( - 0.85294 - 0.000365* bigt ) * bigt + + ( - 0.42647 - 0.000365 * bigt - 0.041802 * t ) * t ) * tas2r; + + /* Rotation matrix */ + rotmat (323, -zeta, theta, -z, rmatp); + return; +} + + +void +mprecfk5 (ep0, ep1, rmatp) + +double ep0; /* Beginning epoch */ +double ep1; /* Ending epoch */ +double rmatp[9]; /* 3x3 Precession matrix (returned) */ + +/* +** Form the matrix of precession between two epochs (IAU 1976, FK5). +** Notes: +** 1) The epochs are TDB (loosely ET) Julian epochs. +** 2) The matrix is in the sense v(ep1) = rmatp * v(ep0) . +** +** References: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** equations (6) & (7), p283. +** Kaplan,G.H., 1981. USNO circular no. 163, pa2. +** +** Based on slaPrec(), P.T.Wallace Starlink 31 October 1993 +*/ +{ + double t0, t, tas2r, w, zeta, z, theta; + void rotmat(); + + /* Interval between basic epoch J2000.0 and beginning epoch (JC) */ + t0 = ( ep0 - 2000.0 ) / 100.0; + + /* Interval over which precession required (JC) */ + t = ( ep1 - ep0 ) / 100.0; + + /* Euler angles */ + tas2r = secrad (t); + w = 2306.2181 + ( ( 1.39656 - ( 0.000139 * t0 ) ) * t0 ); + zeta = (w + ( ( 0.30188 - 0.000344 * t0 ) + 0.017998 * t ) * t ) * tas2r; + z = (w + ( ( 1.09468 + 0.000066 * t0 ) + 0.018203 * t ) * t ) * tas2r; + theta = ( ( 2004.3109 + ( - 0.85330 - 0.000217 * t0 ) * t0 ) + + ( ( -0.42665 - 0.000217 * t0 ) - 0.041833 * t ) * t ) * tas2r; + + /* Rotation matrix */ + rotmat (323, -zeta, theta, -z, rmatp); + return; +} + + +/* Make 3-D rotation matrix from up to three rotations */ + +void +rotmat (axes, rot1, rot2, rot3, matrix) + +int axes; /* Axes about which coordinates are rotated (1=x, 2=y, 3=z) */ +double rot1; /* First rotation in degrees */ +double rot2; /* Second rotation in degrees */ +double rot3; /* Third rotation in degrees */ +double *matrix; /* 3x3 rotation matrix (returned) */ + +{ + int i, j, k, naxis, iaxes, iaxis; + double rot[3], srot, crot, *mati, w, wm[9], *wmi, matn[9]; + int axis[3]; + + /* Initial final rotation matrix */ + mati = matrix; + for (i = 0; i < 3; i++) { + for (j=0; j < 3; j++) { + if (i == j) + *mati++ = 1.0; + else + *mati++ = 0.0; + } + } + + /* Separate digits of rotation axis string and count rotations */ + naxis = 0; + iaxes = axes; + axis[0] = iaxes / 100; + if (axis[0] > 0) { + naxis++; + iaxes = iaxes - (100 * axis[0]); + } + axis[naxis] = iaxes / 10; + if (axis[naxis] > 0) { + iaxes = iaxes - (10 * axis[naxis]); + naxis++; + } + axis[naxis] = iaxes; + if (axis[naxis] > 0) + naxis++; + + /* Set up rotation angles */ + rot[0] = rot1; + rot[1] = rot2; + rot[2] = rot3; + + /* For each digit of axis string, set up matrix */ + for (iaxis = 0; iaxis < naxis; iaxis++) { + + /* Initialize current rotation matrix */ + mati = matn; + for (i = 0; i < 3; i++) { + for (j=0; j < 3; j++) { + if (i == j) + *mati++ = 1.0; + else + *mati++ = 0.0; + } + } + + srot = sin (rot[iaxis]); + crot = cos (rot[iaxis]); + + /* Matrix for rotation in X */ + if (axis[iaxis] == 1) { + matn[4] = crot; + matn[5] = srot; + matn[7] = -srot; + matn[8] = crot; + } + + /* Matrix for rotation in Y */ + else if (axis[iaxis] == 2) { + matn[0] = crot; + matn[2] = -srot; + matn[6] = srot; + matn[8] = crot; + } + + /* Matrix for rotation in Z */ + else { + matn[0] = crot; + matn[1] = srot; + matn[3] = -srot; + matn[4] = crot; + } + + /* Multiply existing rotation matrix by new rotation matrix */ + for (i = 0; i < 3; i++) { + for (j = 0; j < 3; j++) { + w = 0.0; + for (k = 0; k < 3; k++) + w+= matn[3*i + k] * matrix[3*k + j]; + wm[3*i + j] = w; + } + } + + /* Update output matrix */ + mati = matrix; + wmi = wm; + for (i = 0; i < 9; i++) { + *mati++ = *wmi++; + } + } + return; +} + + +/* The following routines are from Doug Mink's Fortran ephemeris library */ + +/* Convert right ascensiona and declination in degrees and distance to + geocentric equatorial rectangular coordinates */ + +void +d2v3 (rra,rdec,r,pos) + +double rra; /* Right ascension in degrees */ +double rdec; /* Declination in degrees */ +double r; /* Distance to object in same units as pos */ +double pos[3]; /* x,y,z geocentric equatorial position of object (returned) */ +{ + s2v3 (degrad (rra), degrad (rdec), r, pos); + + return; +} + + +/* Convert right ascension, declination, and distance to + geocentric equatorial rectangular coordinates */ + +void +s2v3 (rra,rdec,r,pos) + +double rra; /* Right ascension in radians */ +double rdec; /* Declination in radians */ +double r; /* Distance to object in same units as pos */ +double pos[3]; /* x,y,z geocentric equatorial position of object (returned) */ +{ + pos[0] = r * cos (rra) * cos (rdec); + pos[1] = r * sin (rra) * cos (rdec); + pos[2] = r * sin (rdec); + + return; +} + + +/* Convert geocentric equatorial rectangular coordinates to + right ascension and declination in degrees and distance */ + +void +v2d3 (pos,rra,rdec,r) + +double pos[3]; /* x,y,z geocentric equatorial position of object */ +double *rra; /* Right ascension in degrees (returned) */ +double *rdec; /* Declination in degrees (returned) */ +double *r; /* Distance to object in same units as pos (returned) */ +{ + v2s3 (pos, rra, rdec, r); + *rra = raddeg (*rra); + *rdec = raddeg (*rdec); + return; +} + +/* Convert geocentric equatorial rectangular coordinates to + right ascension, declination, and distance */ + +void +v2s3 (pos,rra,rdec,r) + +double pos[3]; /* x,y,z geocentric equatorial position of object */ +double *rra; /* Right ascension in radians (returned) */ +double *rdec; /* Declination in radians (returned) */ +double *r; /* Distance to object in same units as pos (returned) */ +{ + double x,y,z,rxy,rxy2,z2; + + x = pos[0]; + y = pos[1]; + z = pos[2]; + + *rra = atan2 (y, x); + + /* Keep RA within 0 to 2pi range */ + if (*rra < 0.0) + *rra = *rra + (2.0 * PI); + if (*rra > 2.0 * PI) + *rra = *rra - (2.0 * PI); + + rxy2 = x*x + y*y; + rxy = sqrt (rxy2); + *rdec = atan2 (z, rxy); + + z2 = z * z; + *r = sqrt (rxy2 + z2); + + return; +} + +/* + * Nov 6 1995 Include stdlib.h instead of malloc.h + * Apr 1 1996 Add arbitrary epoch precession + * Apr 26 1996 Add FK4 <-> FK5 subroutines for use when epoch is known + * Aug 6 1996 Clean up after lint + * Nov 4 1996 Break SLA subroutines into separate file slasubs.c + * Dec 9 1996 Change arguments to degrees in FK4 and FK5 precession programs + * Dec 10 1996 All subroutine arguments are degrees except vector conversions + * + * Mar 20 1997 Drop unused variables after lint + * + * Apr 14 1998 Add ecliptic coordinate conversions and general conversion routines + * Apr 23 1998 Add LINEAR coordinate system + * Apr 28 1998 Change coordinate system flags to WCS_* + * Apr 28 1998 Return -1 from wcscsys if not a legal coordinate system + * May 7 1998 Keep theta within 0 to 2pi in ecl2fk5() + * May 13 1998 Add wcsceq() + * May 13 1998 Add equinox arguments to wcscon() + * Jun 24 1998 Set J2000 from ICRS in wcscsys() + * Jul 9 1998 Include stdio.h for fprintf() and sprintf() declarations + * Sep 17 1998 Add wcscstr() to get coordinate string + * Sep 21 1998 Fix bug in wcscstr() which returned B2000 instead of J2000 + * Sep 21 1998 Add subroutine to convert proper motions, too. + * Oct 21 1998 In wcscstr(), drop .00 from returned string + * Nov 18 1998 Rename jpcop() v2s3() and jpcon() s2v3() (spherical to vector) + * Dec 2 1998 Add PLANET coordinate system to wcscsys() and wcscstr() + * + * Mar 10 2000 Precess coordinates correctly from other than 1950.0 and 2000.0 + * Mar 10 2000 Set coordinate system to J2000 or B1950 if string is numeric + * Mar 14 2000 Clean up code in fk524m() and fk425m() + * May 31 2000 Add proper motion correctly if proper motion precessed + * Jun 26 2000 Add some support for WCS_XY image coordinates + * Sep 14 2000 Return -1 from wcscsys if equinox is less than 1900.0 + * Oct 31 2000 Add proper motion after fk425 or fk524 from system epoch + * Oct 31 2000 Fix proper motion units in fk524p() and fk425p() + * Nov 6 2000 Update fk425 and fk524 algorithms to include parallax and rv + * + * Jan 11 2001 Print all messages to stderr + * Mar 21 2001 Move braces around bgal[] and jgal[] matrix initialization + * + * Feb 13 2002 Fix precession units problem in ecl2fk5() and fk52ecl() + * + * Apr 13 2005 Replace all sla_lib calls with local code + * Nov 1 2005 Add WCS_ICRS, and unprecessable system + * + * Jan 5 2006 Fix bugs in precession subroutines mprecxxx() + * May 3 2006 Drop declarations of unused variables suggested by Robert Lupton + * Oct 6 2006 If pixel coordinates, set system to WCS_XY in wcscsys() + * Oct 30 2006 Add LINEAR and ICRS to wcscstr() returns + * + * Aug 15 2007 Clean up code in rotmat() + * Nov 8 2007 In wcsconp, make it clear that proper motion is in spherical coordinates + * + * Mar 29 2010 Fix bug in computing the magnitude of the e-terms in fk524() + * Mar 30 2010 Drop ep1 assignment after line 178 in wcsconp() + */ diff --git a/tksao/wcssubs/wcsinit.c b/tksao/wcssubs/wcsinit.c new file mode 100644 index 0000000..8bbe6c1 --- /dev/null +++ b/tksao/wcssubs/wcsinit.c @@ -0,0 +1,1616 @@ +/*** File libwcs/wcsinit.c + *** July 24, 2013 + *** By Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** Copyright (C) 1998-2013 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + + * Module: wcsinit.c (World Coordinate Systems) + * Purpose: Convert FITS WCS to pixels and vice versa: + * Subroutine: wcsinit (hstring) sets a WCS structure from an image header + * Subroutine: wcsninit (hstring,lh) sets a WCS structure from fixed-length header + * Subroutine: wcsinitn (hstring, name) sets a WCS structure for specified WCS + * Subroutine: wcsninitn (hstring,lh, name) sets a WCS structure for specified WCS + * Subroutine: wcsinitc (hstring, mchar) sets a WCS structure if multiple + * Subroutine: wcsninitc (hstring,lh,mchar) sets a WCS structure if multiple + * Subroutine: wcschar (hstring, name) returns suffix for specifed WCS + * Subroutine: wcseq (hstring, wcs) set radecsys and equinox from image header + * Subroutine: wcseqm (hstring, wcs, mchar) set radecsys and equinox if multiple + */ + +#include <string.h> /* strstr, NULL */ +#include <stdio.h> /* stderr */ +#include <math.h> +#include "wcs.h" +#ifndef VMS +#include <stdlib.h> +#endif + +static void wcseq(); +static void wcseqm(); +static void wcsioset(); +void wcsrotset(); +char wcschar(); + +/* set up a WCS structure from a FITS image header lhstring bytes long + * for a specified WCS name */ + +struct WorldCoor * +wcsninitn (hstring, lhstring, name) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +int lhstring; /* Length of FITS header in bytes */ +const char *name; /* character string with identifying name of WCS */ +{ + hlength (hstring, lhstring); + return (wcsinitn (hstring, name)); +} + + +/* set up a WCS structure from a FITS image header for specified WCSNAME */ + +struct WorldCoor * +wcsinitn (hstring, name) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +const char *name; /* character string with identifying name of WCS */ +{ + char mchar; /* Suffix character for one of multiple WCS */ + + mchar = wcschar (hstring, name); + if (mchar == '_') { + fprintf (stderr, "WCSINITN: WCS name %s not matched in FITS header\n", + name); + return (NULL); + } + return (wcsinitc (hstring, &mchar)); +} + + +/* WCSCHAR -- Find the letter for a specific WCS conversion */ + +char +wcschar (hstring, name) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +const char *name; /* Name of WCS conversion to be matched + (case-independent) */ +{ + char *upname; + char cwcs, charwcs; + int iwcs; + char keyword[12]; + char *upval, value[72]; + + /* If no WCS character, return 0 */ + if (name == NULL) + return ((char) 0); + + /* Convert input name to upper case */ + upname = uppercase (name); + + /* If single character name, return that character */ + if (strlen (upname) == 1) + return (upname[0]); + + /* Try to match input name to available WCSNAME names in header */ + strcpy (keyword, "WCSNAME"); + keyword[8] = (char) 0; + charwcs = '_'; + for (iwcs = 0; iwcs < 27; iwcs++) { + if (iwcs > 0) + cwcs = (char) (64 + iwcs); + else + cwcs = (char) 0; + keyword[7] = cwcs; + if (hgets (hstring, keyword, 72, value)) { + upval = uppercase (value); + if (!strcmp (upval, upname)) + charwcs = cwcs; + free (upval); + } + } + free (upname); + return (charwcs); +} + + +/* Make string of arbitrary case all uppercase */ + +char * +uppercase (string) +const char *string; +{ + int lstring, i; + char *upstring; + + lstring = strlen (string); + upstring = (char *) calloc (1,lstring+1); + for (i = 0; i < lstring; i++) { + if (string[i] > 96 && string[i] < 123) + upstring[i] = string[i] - 32; + else + upstring[i] = string[i]; + } + upstring[lstring] = (char) 0; + return (upstring); +} + + +/* set up a WCS structure from a FITS image header lhstring bytes long */ + +struct WorldCoor * +wcsninit (hstring, lhstring) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +int lhstring; /* Length of FITS header in bytes */ +{ + char mchar; /* Suffix character for one of multiple WCS */ + mchar = (char) 0; + hlength (hstring, lhstring); + return (wcsinitc (hstring, &mchar)); +} + + +/* set up a WCS structure from a FITS image header lhstring bytes long */ + +struct WorldCoor * +wcsninitc (hstring, lhstring, mchar) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +int lhstring; /* Length of FITS header in bytes */ +char *mchar; /* Suffix character for one of multiple WCS */ +{ + hlength (hstring, lhstring); + if (mchar[0] == ' ') + mchar[0] = (char) 0; + return (wcsinitc (hstring, mchar)); +} + + +/* set up a WCS structure from a FITS image header */ + +struct WorldCoor * +wcsinit (hstring) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +{ + char mchar; /* Suffix character for one of multiple WCS */ + mchar = (char) 0; + return (wcsinitc (hstring, &mchar)); +} + + +/* set up a WCS structure from a FITS image header for specified suffix */ + +struct WorldCoor * +wcsinitc (hstring, wchar) + +const char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +char *wchar; /* Suffix character for one of multiple WCS */ +{ + struct WorldCoor *wcs, *depwcs; + char ctype1[32], ctype2[32], tstring[32]; + char pvkey1[8],pvkey2[8],pvkey3[8]; + char *hcoeff; /* pointer to first coeff's in header */ + char decsign; + double rah,ram,ras, dsign,decd,decm,decs; + double dec_deg,ra_hours, secpix, ra0, ra1, dec0, dec1, cvel; + double cdelt1, cdelt2, cd[4], pc[81]; + char keyword[16]; + int ieq, i, j, k, naxes, cd11p, cd12p, cd21p, cd22p; + int ilat; /* coordinate for latitude or declination */ + /* + int ix1, ix2, iy1, iy2, idx1, idx2, idy1, idy2; + double dxrefpix, dyrefpix; + */ + char temp[80]; + char wcsname[64]; /* Name of WCS depended on by current WCS */ + char mchar; + char cspace = (char) ' '; + char cnull = (char) 0; + double mjd; + double rot; + double ut; + int nax; + int twod; + extern int tnxinit(); + extern int zpxinit(); + extern int platepos(); + extern int dsspos(); + void invert_wcs(); + + wcs = (struct WorldCoor *) calloc (1, sizeof(struct WorldCoor)); + + /* Set WCS character and name in structure */ + mchar = wchar[0]; + if (mchar == ' ') + mchar = cnull; + wcs->wcschar = mchar; + if (hgetsc (hstring, "WCSNAME", &mchar, 63, wcsname)) { + wcs->wcsname = (char *) calloc (strlen (wcsname)+2, 1); + strcpy (wcs->wcsname, wcsname); + } + + + /* Set WCSLIB flags so that structures will be reinitialized */ + wcs->cel.flag = 0; + wcs->lin.flag = 0; + wcs->wcsl.flag = 0; + wcs->wcsl.cubeface = -1; + + /* Initialize to no plate fit */ + wcs->ncoeff1 = 0; + wcs->ncoeff2 = 0; + + /* Initialize to no CD matrix */ + cdelt1 = 0.0; + cdelt2 = 0.0; + cd[0] = 0.0; + cd[1] = 0.0; + cd[2] = 0.0; + cd[3] = 0.0; + pc[0] = 0.0; + wcs->rotmat = 0; + wcs->rot = 0.0; + + /* Header parameters independent of projection */ + naxes = 0; + hgeti4c (hstring, "WCSAXES", &mchar, &naxes); + if (naxes == 0) + hgeti4 (hstring, "WCSAXES", &naxes); + if (naxes == 0) + hgeti4 (hstring, "NAXIS", &naxes); + if (naxes == 0) + hgeti4 (hstring, "WCSDIM", &naxes); + if (naxes < 1) { + setwcserr ("WCSINIT: No WCSAXES, NAXIS, or WCSDIM keyword"); + wcsfree (wcs); + return (NULL); + } + if (naxes > 2) + naxes = 2; + wcs->naxis = naxes; + wcs->naxes = naxes; + wcs->lin.naxis = naxes; + wcs->nxpix = 0; + hgetr8 (hstring, "NAXIS1", &wcs->nxpix); + if (wcs->nxpix < 1) + hgetr8 (hstring, "IMAGEW", &wcs->nxpix); + if (wcs->nxpix < 1) { + setwcserr ("WCSINIT: No NAXIS1 or IMAGEW keyword"); + wcsfree (wcs); + return (NULL); + } + wcs->nypix = 0; + hgetr8 (hstring, "NAXIS2", &wcs->nypix); + if (wcs->nypix < 1) + hgetr8 (hstring, "IMAGEH", &wcs->nypix); + if (naxes > 1 && wcs->nypix < 1) { + setwcserr ("WCSINIT: No NAXIS2 or IMAGEH keyword"); + wcsfree (wcs); + return (NULL); + } + + /* Reset number of axes to only those with dimension greater than one */ + nax = 0; + for (i = 0; i < naxes; i++) { + + /* Check for number of pixels in axis more than one */ + strcpy (keyword, "NAXIS"); + sprintf (temp, "%d", i+1); + strcat (keyword, temp); + if (!hgeti4 (hstring, keyword, &j)) { + if (i == 0 && wcs->nxpix > 1) { + /* fprintf (stderr,"WCSINIT: Missing keyword %s set to %.0f from IMAGEW\n", + keyword, wcs->nxpix); */ + j = wcs->nxpix; + } + else if (i == 1 && wcs->nypix > 1) { + /* fprintf (stderr,"WCSINIT: Missing keyword %s set to %.0f from IMAGEH\n", + keyword, wcs->nypix); */ + j = wcs->nypix; + } + else + fprintf (stderr,"WCSINIT: Missing keyword %s assumed 1\n",keyword); + } + + /* Check for TAB WCS in axis */ + strcpy (keyword, "CTYPE"); + strcat (keyword, temp); + if (hgets (hstring, keyword, 16, temp)) { + if (strsrch (temp, "-TAB")) + j = 0; + } + if (j > 1) nax = nax + 1; + } + naxes = nax; + wcs->naxes = nax; + wcs->naxis = nax; + + hgets (hstring, "INSTRUME", 16, wcs->instrument); + hgeti4 (hstring, "DETECTOR", &wcs->detector); + wcs->wcsproj = getdefwcs(); + wcs->logwcs = 0; + hgeti4 (hstring, "DC-FLAG", &wcs->logwcs); + + /* Initialize rotation matrices */ + for (i = 0; i < 81; i++) wcs->pc[i] = 0.0; + for (i = 0; i < 81; i++) pc[i] = 0.0; + for (i = 0; i < naxes; i++) wcs->pc[(i*naxes)+i] = 1.0; + for (i = 0; i < naxes; i++) pc[(i*naxes)+i] = 1.0; + for (i = 0; i < 9; i++) wcs->cdelt[i] = 0.0; + for (i = 0; i < naxes; i++) wcs->cdelt[i] = 1.0; + + /* If the current world coordinate system depends on another, set it now */ + if (hgetsc (hstring, "WCSDEP",&mchar, 63, wcsname)) { + if ((wcs->wcs = wcsinitn (hstring, wcsname)) == NULL) { + setwcserr ("WCSINIT: depended on WCS could not be set"); + wcsfree (wcs); + return (NULL); + } + depwcs = wcs->wcs; + depwcs->wcsdep = wcs; + } + else + wcs->wcs = NULL; + + /* Read radial velocity from image header */ + wcs->radvel = 0.0; + wcs->zvel = 0.0; + cvel = 299792.5; + if (hgetr8c (hstring, "VSOURCE", &mchar, &wcs->radvel)) + wcs->zvel = wcs->radvel / cvel; + else if (hgetr8c (hstring, "ZSOURCE", &mchar, &wcs->zvel)) + wcs->radvel = wcs->zvel * cvel; + else if (hgetr8 (hstring, "VELOCITY", &wcs->radvel)) + wcs->zvel = wcs->radvel / cvel; + + for (i = 0; i < 10; i++) { + wcs->prj.p[i] = 0.0; + } + + /* World coordinate system reference coordinate information */ + if (hgetsc (hstring, "CTYPE1", &mchar, 16, ctype1)) { + + /* Read second coordinate type */ + strcpy (ctype2, ctype1); + if (!hgetsc (hstring, "CTYPE2", &mchar, 16, ctype2)) + twod = 0; + else + twod = 1; + strncpy (wcs->ctype[0], ctype1, 8); + strncpy (wcs->ctype[1], ctype2, 8); + if (strsrch (ctype2, "LAT") || strsrch (ctype2, "DEC")) + ilat = 2; + else + ilat = 1; + + /* Read third and fourth coordinate types, if present */ + strcpy (wcs->ctype[2], ""); + hgetsc (hstring, "CTYPE3", &mchar, 9, wcs->ctype[2]); + strcpy (wcs->ctype[3], ""); + hgetsc (hstring, "CTYPE4", &mchar, 9, wcs->ctype[3]); + + /* Set projection type in WCS data structure */ + if (wcstype (wcs, ctype1, ctype2)) { + wcsfree (wcs); + return (NULL); + } + + /* Get units, if present, for linear coordinates */ + if (wcs->prjcode == WCS_LIN) { + if (!hgetsc (hstring, "CUNIT1", &mchar, 16, wcs->units[0])) { + if (!mgetstr (hstring, "WAT1", "units", 16, wcs->units[0])) { + wcs->units[0][0] = 0; + } + } + if (!strcmp (wcs->units[0], "pixel")) + wcs->prjcode = WCS_PIX; + if (twod) { + if (!hgetsc (hstring, "CUNIT2", &mchar, 16, wcs->units[1])) { + if (!mgetstr (hstring, "WAT2", "units", 16, wcs->units[1])) { + wcs->units[1][0] = 0; + } + } + if (!strcmp (wcs->units[0], "pixel")) + wcs->prjcode = WCS_PIX; + } + } + + /* Reference pixel coordinates and WCS value */ + wcs->crpix[0] = 1.0; + hgetr8c (hstring, "CRPIX1", &mchar, &wcs->crpix[0]); + wcs->crpix[1] = 1.0; + hgetr8c (hstring, "CRPIX2", &mchar, &wcs->crpix[1]); + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + wcs->crval[0] = 0.0; + hgetr8c (hstring, "CRVAL1", &mchar, &wcs->crval[0]); + wcs->crval[1] = 0.0; + hgetr8c (hstring, "CRVAL2", &mchar, &wcs->crval[1]); + if (wcs->syswcs == WCS_NPOLE) + wcs->crval[1] = 90.0 - wcs->crval[1]; + if (wcs->syswcs == WCS_SPA) + wcs->crval[1] = wcs->crval[1] - 90.0; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + if (wcs->coorflip) { + wcs->cel.ref[0] = wcs->crval[1]; + wcs->cel.ref[1] = wcs->crval[0]; + } + else { + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + } + wcs->longpole = 999.0; + hgetr8c (hstring, "LONPOLE", &mchar, &wcs->longpole); + wcs->cel.ref[2] = wcs->longpole; + wcs->latpole = 999.0; + hgetr8c (hstring, "LATPOLE", &mchar, &wcs->latpole); + wcs->cel.ref[3] = wcs->latpole; + wcs->lin.crpix = wcs->crpix; + wcs->lin.cdelt = wcs->cdelt; + wcs->lin.pc = wcs->pc; + + /* Projection constants (this should be projection-dependent */ + wcs->prj.r0 = 0.0; + hgetr8c (hstring, "PROJR0", &mchar, &wcs->prj.r0); + + /* FITS WCS interim proposal projection constants */ + for (i = 0; i < 10; i++) { + sprintf (keyword,"PROJP%d",i); + hgetr8c (hstring, keyword, &mchar, &wcs->prj.p[i]); + } + + sprintf (pvkey1, "PV%d_1", ilat); + sprintf (pvkey2, "PV%d_2", ilat); + sprintf (pvkey3, "PV%d_3", ilat); + + /* FITS WCS standard projection constants (projection-dependent) */ + if (wcs->prjcode == WCS_AZP || wcs->prjcode == WCS_SIN || + wcs->prjcode == WCS_COP || wcs->prjcode == WCS_COE || + wcs->prjcode == WCS_COD || wcs->prjcode == WCS_COO) { + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + hgetr8c (hstring, pvkey2, &mchar, &wcs->prj.p[2]); + } + else if (wcs->prjcode == WCS_SZP) { + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + hgetr8c (hstring, pvkey2, &mchar, &wcs->prj.p[2]); + if (wcs->prj.p[3] == 0.0) + wcs->prj.p[3] = 90.0; + hgetr8c (hstring, pvkey3, &mchar, &wcs->prj.p[3]); + } + else if (wcs->prjcode == WCS_CEA) { + if (wcs->prj.p[1] == 0.0) + wcs->prj.p[1] = 1.0; + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + } + else if (wcs->prjcode == WCS_CYP) { + if (wcs->prj.p[1] == 0.0) + wcs->prj.p[1] = 1.0; + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + if (wcs->prj.p[2] == 0.0) + wcs->prj.p[2] = 1.0; + hgetr8c (hstring, pvkey2, &mchar, &wcs->prj.p[2]); + } + else if (wcs->prjcode == WCS_AIR) { + if (wcs->prj.p[1] == 0.0) + wcs->prj.p[1] = 90.0; + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + } + else if (wcs->prjcode == WCS_BON) { + hgetr8c (hstring, pvkey1, &mchar, &wcs->prj.p[1]); + } + else if (wcs->prjcode == WCS_ZPN) { + for (i = 0; i < 10; i++) { + sprintf (keyword,"PV%d_%d", ilat, i); + hgetr8c (hstring, keyword, &mchar, &wcs->prj.p[i]); + } + } + + /* Initialize TNX, defaulting to TAN if there is a problem */ + if (wcs->prjcode == WCS_TNX) { + if (tnxinit (hstring, wcs)) { + wcs->ctype[0][6] = 'A'; + wcs->ctype[0][7] = 'N'; + wcs->ctype[1][6] = 'A'; + wcs->ctype[1][7] = 'N'; + wcs->prjcode = WCS_TAN; + } + } + + /* Initialize ZPX, defaulting to ZPN if there is a problem */ + if (wcs->prjcode == WCS_ZPX) { + if (zpxinit (hstring, wcs)) { + wcs->ctype[0][7] = 'N'; + wcs->ctype[1][7] = 'N'; + wcs->prjcode = WCS_ZPN; + } + } + + /* Set TPV to TAN as SCAMP coefficients will be added below */ + /* + if (wcs->prjcode == WCS_TPV) { + wcs->ctype[0][6] = 'A'; + wcs->ctype[0][7] = 'N'; + wcs->ctype[1][6] = 'A'; + wcs->ctype[1][7] = 'N'; + wcs->prjcode = WCS_TAN; + } + */ + /* Coordinate reference frame, equinox, and epoch */ + if (wcs->wcsproj > 0) + wcseqm (hstring, wcs, &mchar); + wcsioset (wcs); + + /* Read distortion coefficients, if present */ + distortinit (wcs, hstring); + + /* Use polynomial fit instead of projection, if present */ + wcs->ncoeff1 = 0; + wcs->ncoeff2 = 0; + cd11p = hgetr8c (hstring, "CD1_1", &mchar, &cd[0]); + cd12p = hgetr8c (hstring, "CD1_2", &mchar, &cd[1]); + cd21p = hgetr8c (hstring, "CD2_1", &mchar, &cd[2]); + cd22p = hgetr8c (hstring, "CD2_2", &mchar, &cd[3]); + if (wcs->wcsproj != WCS_OLD && + (hcoeff = ksearch (hstring,"CO1_1")) != NULL) { + wcs->prjcode = WCS_PLT; + (void)strcpy (wcs->ptype, "PLATE"); + for (i = 0; i < 20; i++) { + sprintf (keyword,"CO1_%d", i+1); + wcs->x_coeff[i] = 0.0; + if (hgetr8 (hcoeff, keyword, &wcs->x_coeff[i])) + wcs->ncoeff1 = i + 1; + } + hcoeff = ksearch (hstring,"CO2_1"); + for (i = 0; i < 20; i++) { + sprintf (keyword,"CO2_%d",i+1); + wcs->y_coeff[i] = 0.0; + if (hgetr8 (hcoeff, keyword, &wcs->y_coeff[i])) + wcs->ncoeff2 = i + 1; + } + + /* Compute a nominal scale factor */ + platepos (wcs->crpix[0], wcs->crpix[1], wcs, &ra0, &dec0); + platepos (wcs->crpix[0], wcs->crpix[1]+1.0, wcs, &ra1, &dec1); + wcs->yinc = dec1 - dec0; + wcs->xinc = -wcs->yinc; + + /* Compute image rotation angle */ + wcs->wcson = 1; + wcsrotset (wcs); + rot = degrad (wcs->rot); + + /* Compute scale at reference pixel */ + platepos (wcs->crpix[0], wcs->crpix[1], wcs, &ra0, &dec0); + platepos (wcs->crpix[0]+cos(rot), + wcs->crpix[1]+sin(rot), wcs, &ra1, &dec1); + wcs->cdelt[0] = -wcsdist (ra0, dec0, ra1, dec1); + wcs->xinc = wcs->cdelt[0]; + platepos (wcs->crpix[0]+sin(rot), + wcs->crpix[1]+cos(rot), wcs, &ra1, &dec1); + wcs->cdelt[1] = wcsdist (ra0, dec0, ra1, dec1); + wcs->yinc = wcs->cdelt[1]; + + /* Set CD matrix from header */ + wcs->cd[0] = cd[0]; + wcs->cd[1] = cd[1]; + wcs->cd[2] = cd[2]; + wcs->cd[3] = cd[3]; + (void) matinv (2, wcs->cd, wcs->dc); + } + + /* Else use CD matrix, if present */ + else if (cd11p || cd12p || cd21p || cd22p) { + wcs->rotmat = 1; + wcscdset (wcs, cd); + } + + /* Else get scaling from CDELT1 and CDELT2 */ + else if (hgetr8c (hstring, "CDELT1", &mchar, &cdelt1) != 0) { + hgetr8c (hstring, "CDELT2", &mchar, &cdelt2); + + /* If CDELT1 or CDELT2 is 0 or missing */ + if (cdelt1 == 0.0 || (wcs->nypix > 1 && cdelt2 == 0.0)) { + if (ksearch (hstring,"SECPIX") != NULL || + ksearch (hstring,"PIXSCALE") != NULL || + ksearch (hstring,"PIXSCAL1") != NULL || + ksearch (hstring,"XPIXSIZE") != NULL || + ksearch (hstring,"SECPIX1") != NULL) { + secpix = 0.0; + hgetr8 (hstring,"SECPIX",&secpix); + if (secpix == 0.0) + hgetr8 (hstring,"PIXSCALE",&secpix); + if (secpix == 0.0) { + hgetr8 (hstring,"SECPIX1",&secpix); + if (secpix != 0.0) { + if (cdelt1 == 0.0) + cdelt1 = -secpix / 3600.0; + if (cdelt2 == 0.0) { + hgetr8 (hstring,"SECPIX2",&secpix); + cdelt2 = secpix / 3600.0; + } + } + else { + hgetr8 (hstring,"XPIXSIZE",&secpix); + if (secpix != 0.0) { + if (cdelt1 == 0.0) + cdelt1 = -secpix / 3600.0; + if (cdelt2 == 0.0) { + hgetr8 (hstring,"YPIXSIZE",&secpix); + cdelt2 = secpix / 3600.0; + } + } + else { + hgetr8 (hstring,"PIXSCAL1",&secpix); + if (secpix != 0.0 && cdelt1 == 0.0) + cdelt1 = -secpix / 3600.0; + if (cdelt2 == 0.0) { + hgetr8 (hstring,"PIXSCAL2",&secpix); + cdelt2 = secpix / 3600.0; + } + } + } + } + else { + if (cdelt1 == 0.0) + cdelt1 = -secpix / 3600.0; + if (cdelt2 == 0.0) + cdelt2 = secpix / 3600.0; + } + } + } + if (cdelt2 == 0.0 && wcs->nypix > 1) + cdelt2 = -cdelt1; + wcs->cdelt[2] = 1.0; + wcs->cdelt[3] = 1.0; + + /* Initialize rotation matrix */ + for (i = 0; i < 81; i++) { + pc[i] = 0.0; + wcs->pc[i] = 0.0; + } + for (i = 0; i < naxes; i++) + pc[(i*naxes)+i] = 1.0; + + /* Read FITS WCS interim rotation matrix */ + if (!mchar && hgetr8 (hstring,"PC001001",&pc[0]) != 0) { + k = 0; + for (i = 0; i < naxes; i++) { + for (j = 0; j < naxes; j++) { + if (i == j) + pc[k] = 1.0; + else + pc[k] = 0.0; + sprintf (keyword, "PC00%1d00%1d", i+1, j+1); + hgetr8 (hstring, keyword, &pc[k++]); + } + } + wcspcset (wcs, cdelt1, cdelt2, pc); + } + + /* Read FITS WCS standard rotation matrix */ + else if (hgetr8c (hstring, "PC1_1", &mchar, &pc[0]) != 0) { + k = 0; + for (i = 0; i < naxes; i++) { + for (j = 0; j < naxes; j++) { + if (i == j) + pc[k] = 1.0; + else + pc[k] = 0.0; + sprintf (keyword, "PC%1d_%1d", i+1, j+1); + hgetr8c (hstring, keyword, &mchar, &pc[k++]); + } + } + wcspcset (wcs, cdelt1, cdelt2, pc); + } + + /* Otherwise, use CROTAn */ + else { + rot = 0.0; + if (ilat == 2) + hgetr8c (hstring, "CROTA2", &mchar, &rot); + else + hgetr8c (hstring,"CROTA1", &mchar, &rot); + wcsdeltset (wcs, cdelt1, cdelt2, rot); + } + } + + /* If no scaling is present, set to 1 per pixel, no rotation */ + else { + wcs->xinc = 1.0; + wcs->yinc = 1.0; + wcs->cdelt[0] = 1.0; + wcs->cdelt[1] = 1.0; + wcs->rot = 0.0; + wcs->rotmat = 0; + setwcserr ("WCSINIT: setting CDELT to 1"); + } + + /* SCAMP convention */ + if (wcs->prjcode == WCS_TAN && wcs->naxis == 2) { + int n = 0; + if (wcs->inv_x) { + poly_end(wcs->inv_x); + wcs->inv_x = NULL; + } + if (wcs->inv_y) { + poly_end(wcs->inv_y); + wcs->inv_y = NULL; + } + wcs->pvfail = 0; + for (i = 0; i < (2*MAXPV); i++) { + wcs->projppv[i] = 0.0; + wcs->prj.ppv[i] = 0.0; + } + for (k = 0; k < 2; k++) { + for (j = 0; j < MAXPV; j++) { + sprintf(keyword, "PV%d_%d", k+1, j); + if (hgetr8c(hstring, keyword,&mchar, &wcs->projppv[j+k*MAXPV]) == 0) { + wcs->projppv[j+k*MAXPV] = 0.0; + } + else + n++; + } + } + + /* If any PVi_j are set, add them in the structure if no SIRTF distortion*/ + if (n > 0 && wcs->distcode != DISTORT_SIRTF) { + n = 0; + + for (k = MAXPV; k >= 0; k--) { + /* lat comes first for compatibility reasons */ + wcs->prj.ppv[k] = wcs->projppv[k+wcs->wcsl.lat*MAXPV]; + wcs->prj.ppv[k+MAXPV] = wcs->projppv[k+wcs->wcsl.lng*MAXPV]; + if (!n && (wcs->prj.ppv[k] || wcs->prj.ppv[k+MAXPV])) { + n = k+1; + } + } + invert_wcs(wcs); + + /* Need to call tanset again */ + wcs->cel.flag = 0; + } + } + + /* If linear or pixel WCS, print "degrees" */ + if (!strncmp (wcs->ptype,"LINEAR",6) || + !strncmp (wcs->ptype,"PIXEL",5)) { + wcs->degout = -1; + wcs->ndec = 5; + } + + /* Epoch of image (from observation date, if possible) */ + if (hgetr8 (hstring, "MJD-OBS", &mjd)) + wcs->epoch = 1900.0 + (mjd - 15019.81352) / 365.242198781; + else if (!hgetdate (hstring,"DATE-OBS",&wcs->epoch)) { + if (!hgetdate (hstring,"DATE",&wcs->epoch)) { + if (!hgetr8 (hstring,"EPOCH",&wcs->epoch)) + wcs->epoch = wcs->equinox; + } + } + + /* Add time of day if not part of DATE-OBS string */ + else { + hgets (hstring,"DATE-OBS",32,tstring); + if (!strchr (tstring,'T')) { + if (hgetr8 (hstring, "UT",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + else if (hgetr8 (hstring, "UTMID",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + } + } + + wcs->wcson = 1; + } + + else if (mchar != cnull && mchar != cspace) { + (void) sprintf (temp, "WCSINITC: No image scale for WCS %c", mchar); + setwcserr (temp); + wcsfree (wcs); + return (NULL); + } + + /* Plate solution coefficients */ + else if (ksearch (hstring,"PLTRAH") != NULL) { + wcs->prjcode = WCS_DSS; + hcoeff = ksearch (hstring,"PLTRAH"); + hgetr8 (hcoeff,"PLTRAH",&rah); + hgetr8 (hcoeff,"PLTRAM",&ram); + hgetr8 (hcoeff,"PLTRAS",&ras); + ra_hours = rah + (ram / (double)60.0) + (ras / (double)3600.0); + wcs->plate_ra = hrrad (ra_hours); + decsign = '+'; + hgets (hcoeff,"PLTDECSN", 1, &decsign); + if (decsign == '-') + dsign = -1.; + else + dsign = 1.; + hgetr8 (hcoeff,"PLTDECD",&decd); + hgetr8 (hcoeff,"PLTDECM",&decm); + hgetr8 (hcoeff,"PLTDECS",&decs); + dec_deg = dsign * (decd+(decm/(double)60.0)+(decs/(double)3600.0)); + wcs->plate_dec = degrad (dec_deg); + hgetr8 (hstring,"EQUINOX",&wcs->equinox); + hgeti4 (hstring,"EQUINOX",&ieq); + if (ieq == 1950) + strcpy (wcs->radecsys,"FK4"); + else + strcpy (wcs->radecsys,"FK5"); + wcs->epoch = wcs->equinox; + hgetr8 (hstring,"EPOCH",&wcs->epoch); + (void)sprintf (wcs->center,"%2.0f:%2.0f:%5.3f %c%2.0f:%2.0f:%5.3f %s", + rah,ram,ras,decsign,decd,decm,decs,wcs->radecsys); + hgetr8 (hstring,"PLTSCALE",&wcs->plate_scale); + hgetr8 (hstring,"XPIXELSZ",&wcs->x_pixel_size); + hgetr8 (hstring,"YPIXELSZ",&wcs->y_pixel_size); + hgetr8 (hstring,"CNPIX1",&wcs->x_pixel_offset); + hgetr8 (hstring,"CNPIX2",&wcs->y_pixel_offset); + hcoeff = ksearch (hstring,"PPO1"); + for (i = 0; i < 6; i++) { + sprintf (keyword,"PPO%d", i+1); + wcs->ppo_coeff[i] = 0.0; + hgetr8 (hcoeff,keyword,&wcs->ppo_coeff[i]); + } + hcoeff = ksearch (hstring,"AMDX1"); + for (i = 0; i < 20; i++) { + sprintf (keyword,"AMDX%d", i+1); + wcs->x_coeff[i] = 0.0; + hgetr8 (hcoeff, keyword, &wcs->x_coeff[i]); + } + hcoeff = ksearch (hstring,"AMDY1"); + for (i = 0; i < 20; i++) { + sprintf (keyword,"AMDY%d",i+1); + wcs->y_coeff[i] = 0.0; + hgetr8 (hcoeff, keyword, &wcs->y_coeff[i]); + } + wcs->wcson = 1; + (void)strcpy (wcs->c1type, "RA"); + (void)strcpy (wcs->c2type, "DEC"); + (void)strcpy (wcs->ptype, "DSS"); + wcs->degout = 0; + wcs->ndec = 3; + + /* Compute a nominal reference pixel at the image center */ + strcpy (wcs->ctype[0], "RA---DSS"); + strcpy (wcs->ctype[1], "DEC--DSS"); + wcs->crpix[0] = 0.5 * wcs->nxpix; + wcs->crpix[1] = 0.5 * wcs->nypix; + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + dsspos (wcs->crpix[0], wcs->crpix[1], wcs, &ra0, &dec0); + wcs->crval[0] = ra0; + wcs->crval[1] = dec0; + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + + /* Compute a nominal scale factor */ + dsspos (wcs->crpix[0], wcs->crpix[1]+1.0, wcs, &ra1, &dec1); + wcs->yinc = dec1 - dec0; + wcs->xinc = -wcs->yinc; + wcsioset (wcs); + + /* Compute image rotation angle */ + wcs->wcson = 1; + wcsrotset (wcs); + rot = degrad (wcs->rot); + + /* Compute image scale at center */ + dsspos (wcs->crpix[0]+cos(rot), + wcs->crpix[1]+sin(rot), wcs, &ra1, &dec1); + wcs->cdelt[0] = -wcsdist (ra0, dec0, ra1, dec1); + dsspos (wcs->crpix[0]+sin(rot), + wcs->crpix[1]+cos(rot), wcs, &ra1, &dec1); + wcs->cdelt[1] = wcsdist (ra0, dec0, ra1, dec1); + + /* Set all other image scale parameters */ + wcsdeltset (wcs, wcs->cdelt[0], wcs->cdelt[1], wcs->rot); + } + + /* Approximate world coordinate system if plate scale is known */ + else if ((ksearch (hstring,"SECPIX") != NULL || + ksearch (hstring,"PIXSCALE") != NULL || + ksearch (hstring,"PIXSCAL1") != NULL || + ksearch (hstring,"XPIXSIZE") != NULL || + ksearch (hstring,"SECPIX1") != NULL)) { + secpix = 0.0; + hgetr8 (hstring,"SECPIX",&secpix); + if (secpix == 0.0) + hgetr8 (hstring,"PIXSCALE",&secpix); + if (secpix == 0.0) { + hgetr8 (hstring,"SECPIX1",&secpix); + if (secpix != 0.0) { + cdelt1 = -secpix / 3600.0; + hgetr8 (hstring,"SECPIX2",&secpix); + cdelt2 = secpix / 3600.0; + } + else { + hgetr8 (hstring,"XPIXSIZE",&secpix); + if (secpix != 0.0) { + cdelt1 = -secpix / 3600.0; + hgetr8 (hstring,"YPIXSIZE",&secpix); + cdelt2 = secpix / 3600.0; + } + else { + hgetr8 (hstring,"PIXSCAL1",&secpix); + cdelt1 = -secpix / 3600.0; + hgetr8 (hstring,"PIXSCAL2",&secpix); + cdelt2 = secpix / 3600.0; + } + } + } + else { + cdelt2 = secpix / 3600.0; + cdelt1 = -cdelt2; + } + + /* Get rotation angle from the header, if it's there */ + rot = 0.0; + hgetr8 (hstring,"CROTA1", &rot); + if (wcs->rot == 0.) + hgetr8 (hstring,"CROTA2", &rot); + + /* Set CD and PC matrices */ + wcsdeltset (wcs, cdelt1, cdelt2, rot); + + /* By default, set reference pixel to center of image */ + wcs->crpix[0] = 0.5 + (wcs->nxpix * 0.5); + wcs->crpix[1] = 0.5 + (wcs->nypix * 0.5); + + /* Get reference pixel from the header, if it's there */ + if (ksearch (hstring,"CRPIX1") != NULL) { + hgetr8 (hstring,"CRPIX1",&wcs->crpix[0]); + hgetr8 (hstring,"CRPIX2",&wcs->crpix[1]); + } + + /* Use center of detector array as reference pixel + else if (ksearch (hstring,"DETSIZE") != NULL || + ksearch (hstring,"DETSEC") != NULL) { + char *ic; + hgets (hstring, "DETSIZE", 32, temp); + ic = strchr (temp, ':'); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ','); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ':'); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ']'); + if (ic != NULL) + *ic = cnull; + sscanf (temp, "%d %d %d %d", &idx1, &idx2, &idy1, &idy2); + dxrefpix = 0.5 * (double) (idx1 + idx2 - 1); + dyrefpix = 0.5 * (double) (idy1 + idy2 - 1); + hgets (hstring, "DETSEC", 32, temp); + ic = strchr (temp, ':'); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ','); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ':'); + if (ic != NULL) + *ic = ' '; + ic = strchr (temp, ']'); + if (ic != NULL) + *ic = cnull; + sscanf (temp, "%d %d %d %d", &ix1, &ix2, &iy1, &iy2); + wcs->crpix[0] = dxrefpix - (double) (ix1 - 1); + wcs->crpix[1] = dyrefpix - (double) (iy1 - 1); + } */ + wcs->xrefpix = wcs->crpix[0]; + wcs->yrefpix = wcs->crpix[1]; + + wcs->crval[0] = -999.0; + if (!hgetra (hstring,"RA",&wcs->crval[0])) { + setwcserr ("WCSINIT: No RA with SECPIX, no WCS"); + wcsfree (wcs); + return (NULL); + } + wcs->crval[1] = -999.0; + if (!hgetdec (hstring,"DEC",&wcs->crval[1])) { + setwcserr ("WCSINIT No DEC with SECPIX, no WCS"); + wcsfree (wcs); + return (NULL); + } + wcs->xref = wcs->crval[0]; + wcs->yref = wcs->crval[1]; + wcs->coorflip = 0; + + wcs->cel.ref[0] = wcs->crval[0]; + wcs->cel.ref[1] = wcs->crval[1]; + wcs->cel.ref[2] = 999.0; + if (!hgetr8 (hstring,"LONPOLE",&wcs->cel.ref[2])) + hgetr8 (hstring,"LONGPOLE",&wcs->cel.ref[2]); + wcs->cel.ref[3] = 999.0; + hgetr8 (hstring,"LATPOLE",&wcs->cel.ref[3]); + + /* Epoch of image (from observation date, if possible) */ + if (hgetr8 (hstring, "MJD-OBS", &mjd)) + wcs->epoch = 1900.0 + (mjd - 15019.81352) / 365.242198781; + else if (!hgetdate (hstring,"DATE-OBS",&wcs->epoch)) { + if (!hgetdate (hstring,"DATE",&wcs->epoch)) { + if (!hgetr8 (hstring,"EPOCH",&wcs->epoch)) + wcs->epoch = wcs->equinox; + } + } + + /* Add time of day if not part of DATE-OBS string */ + else { + hgets (hstring,"DATE-OBS",32,tstring); + if (!strchr (tstring,'T')) { + if (hgetr8 (hstring, "UT",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + else if (hgetr8 (hstring, "UTMID",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + } + } + + /* Coordinate reference frame and equinox */ + (void) wcstype (wcs, "RA---TAN", "DEC--TAN"); + wcs->coorflip = 0; + wcseq (hstring,wcs); + wcsioset (wcs); + wcs->degout = 0; + wcs->ndec = 3; + wcs->wcson = 1; + } + + else { + setwcserr ("WCSINIT: No image scale"); + wcsfree (wcs); + return (NULL); + } + + wcs->lin.crpix = wcs->crpix; + wcs->lin.cdelt = wcs->cdelt; + wcs->lin.pc = wcs->pc; + + wcs->printsys = 1; + wcs->tabsys = 0; + wcs->linmode = 0; + + /* Initialize special WCS commands */ + setwcscom (wcs); + + return (wcs); +} + + +/******* invert_wcs *********************************************************** +PROTO void invert_wcs(wcsstruct *wcs) +PURPOSE Invert WCS projection mapping (using a polynomial). +INPUT WCS structure. +OUTPUT -. +NOTES . +AUTHOR E. Bertin (IAP) +VERSION 06/11/2003 + ***/ + +void +invert_wcs( struct WorldCoor *wcs) + +{ + polystruct *poly; + double pixin[NAXISPV],raw[NAXISPV],rawmin[NAXISPV]; + double *outpos,*outpost, *lngpos,*lngpost; + double *latpos,*latpost,lngstep,latstep, rawsize, epsilon; + int group[] = {1,1}; + /* Don't ask, this is needed by poly_init()! */ + int i,j,lng,lat,deg, maxflag; + char errstr[80]; + double xmin; + double ymin; + double xmax; + double ymax; + double lngmin; + double latmin; + + /* Check first that inversion is not straightforward */ + lng = wcs->wcsl.lng; + lat = wcs->wcsl.lat; + + if (wcs->naxis != NAXISPV) { + return; + } + + if (strcmp(wcs->wcsl.pcode, "TAN") != 0) { + return; + } + + if ((wcs->projppv[1+lng*MAXPV] == 0) && + (wcs->projppv[1+lat*MAXPV] == 0)) { + return; + } + + if (wcs->wcs != NULL) { + pix2wcs(wcs->wcs,0,0,&xmin,&ymin); + pix2wcs(wcs->wcs,wcs->nxpix,wcs->nypix,&xmax,&ymax); + } + else { + xmin = 0; + ymin = 0; + xmax = wcs->nxpix; + ymax = wcs->nypix; + } + + /* We define x as "longitude" and y as "latitude" projections */ + /* We assume that PCxx cross-terms with additional dimensions are small */ + /* Sample the whole image with a regular grid */ + if (lng == 0) { + lngstep = (xmax-xmin)/(WCS_NGRIDPOINTS-1.0); + lngmin = xmin; + latstep = (ymax-ymin)/(WCS_NGRIDPOINTS-1.0); + latmin = ymin; + } + else { + lngstep = (ymax-ymin)/(WCS_NGRIDPOINTS-1.0); + lngmin = ymin; + latstep = (xmax-xmin)/(WCS_NGRIDPOINTS-1.0); + latmin = xmin; + } + + outpos = (double *)calloc(2*WCS_NGRIDPOINTS2,sizeof(double)); + lngpos = (double *)calloc(WCS_NGRIDPOINTS2,sizeof(double)); + latpos = (double *)calloc(WCS_NGRIDPOINTS2,sizeof(double)); + raw[lat] = rawmin[lat] = 0.5+latmin; + raw[lng] = rawmin[lng] = 0.5+lngmin; + outpost = outpos; + lngpost = lngpos; + latpost = latpos; + for (j=WCS_NGRIDPOINTS; j--; raw[lat]+=latstep) { + raw[lng] = rawmin[lng]; + for (i=WCS_NGRIDPOINTS; i--; raw[lng]+=lngstep) { + if (linrev(raw, &wcs->lin, pixin)) { + sprintf (errstr,"*Error*: incorrect linear conversion in %s", + wcs->wcsl.pcode); + setwcserr (errstr); + } + *(lngpost++) = pixin[lng]; + *(latpost++) = pixin[lat]; + raw_to_pv (&wcs->prj,pixin[lng],pixin[lat], outpost, outpost+1); + outpost += 2; + } + } + + /* Invert "longitude" */ + /* Compute the extent of the pixel in reduced projected coordinates */ + linrev(rawmin, &wcs->lin, pixin); + pixin[lng] += S2D; + linfwd(pixin, &wcs->lin, raw); + rawsize = sqrt((raw[lng]-rawmin[lng])*(raw[lng]-rawmin[lng]) + +(raw[lat]-rawmin[lat])*(raw[lat]-rawmin[lat]))*D2S; + if (!rawsize) { + sprintf (errstr,"*Error*: incorrect linear conversion in %s", + wcs->wcsl.pcode); + setwcserr (errstr); + } + epsilon = WCS_INVACCURACY/rawsize; + + /* Find the lowest degree polynom */ + poly = NULL; /* to avoid gcc -Wall warnings */ + maxflag = 1; + for (deg=1; deg<=WCS_INVMAXDEG && maxflag; deg++) { + if (deg>1) { + poly_end(poly); + } + poly = poly_init(group, 2, °, 1); + poly_fit(poly, outpos, lngpos, NULL, WCS_NGRIDPOINTS2, NULL); + maxflag = 0; + outpost = outpos; + lngpost = lngpos; + for (i=WCS_NGRIDPOINTS2; i--; outpost+=2) { + if (fabs(poly_func(poly, outpost)-*(lngpost++))>epsilon) { + maxflag = 1; + break; + } + } + } + if (maxflag) { + setwcserr ("WARNING: Significant inaccuracy likely to occur in projection"); + wcs->pvfail = 1; + } + + /* Now link the created structure */ + wcs->prj.inv_x = wcs->inv_x = poly; + + /* Invert "latitude" */ + /* Compute the extent of the pixel in reduced projected coordinates */ + linrev(rawmin, &wcs->lin, pixin); + pixin[lat] += S2D; + linfwd(pixin, &wcs->lin, raw); + rawsize = sqrt((raw[lng]-rawmin[lng])*(raw[lng]-rawmin[lng]) + +(raw[lat]-rawmin[lat])*(raw[lat]-rawmin[lat]))*D2S; + if (!rawsize) { + sprintf (errstr,"*Error*: incorrect linear conversion in %s", + wcs->wcsl.pcode); + setwcserr (errstr); + } + epsilon = WCS_INVACCURACY/rawsize; + + /* Find the lowest degree polynom */ + maxflag = 1; + for (deg=1; deg<=WCS_INVMAXDEG && maxflag; deg++) { + if (deg>1) + poly_end(poly); + poly = poly_init(group, 2, °, 1); + poly_fit(poly, outpos, latpos, NULL, WCS_NGRIDPOINTS2, NULL); + maxflag = 0; + outpost = outpos; + latpost = latpos; + for (i=WCS_NGRIDPOINTS2; i--; outpost+=2) { + if (fabs(poly_func(poly, outpost)-*(latpost++))>epsilon) { + maxflag = 1; + break; + } + } + } + if (maxflag) { + setwcserr ("WARNING: Significant inaccuracy likely to occur in projection"); + wcs->pvfail = 1; + } + + /* Now link the created structure */ + wcs->prj.inv_y = wcs->inv_y = poly; + + /* Free memory */ + free(outpos); + free(lngpos); + free(latpos); + + return; +} + + +/* Set coordinate system of image, input, and output */ + +static void +wcsioset (wcs) + +struct WorldCoor *wcs; +{ + if (strlen (wcs->radecsys) == 0 || wcs->prjcode == WCS_LIN) + strcpy (wcs->radecsys, "LINEAR"); + if (wcs->prjcode == WCS_PIX) + strcpy (wcs->radecsys, "PIXEL"); + wcs->syswcs = wcscsys (wcs->radecsys); + + if (wcs->syswcs == WCS_B1950) + strcpy (wcs->radecout, "FK4"); + else if (wcs->syswcs == WCS_J2000) + strcpy (wcs->radecout, "FK5"); + else + strcpy (wcs->radecout, wcs->radecsys); + wcs->sysout = wcscsys (wcs->radecout); + wcs->eqout = wcs->equinox; + strcpy (wcs->radecin, wcs->radecsys); + wcs->sysin = wcscsys (wcs->radecin); + wcs->eqin = wcs->equinox; + return; +} + + +static void +wcseq (hstring, wcs) + +char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +struct WorldCoor *wcs; /* World coordinate system data structure */ +{ + char mchar; /* Suffix character for one of multiple WCS */ + mchar = (char) 0; + wcseqm (hstring, wcs, &mchar); + return; +} + + +static void +wcseqm (hstring, wcs, mchar) + +char *hstring; /* character string containing FITS header information + in the format <keyword>= <value> [/ <comment>] */ +struct WorldCoor *wcs; /* World coordinate system data structure */ +char *mchar; /* Suffix character for one of multiple WCS */ +{ + int ieq = 0; + int eqhead = 0; + char systring[32], eqstring[32]; + char radeckey[16], eqkey[16]; + char tstring[32]; + double ut; + + /* Set equinox from EQUINOX, EPOCH, or RADECSYS; default to 2000 */ + systring[0] = 0; + eqstring[0] = 0; + if (mchar[0]) { + sprintf (eqkey, "EQUINOX%c", mchar[0]); + sprintf (radeckey, "RADECSYS%c", mchar[0]); + } + else { + strcpy (eqkey, "EQUINOX"); + sprintf (radeckey, "RADECSYS"); + } + if (!hgets (hstring, eqkey, 31, eqstring)) { + if (hgets (hstring, "EQUINOX", 31, eqstring)) + strcpy (eqkey, "EQUINOX"); + } + if (!hgets (hstring, radeckey, 31, systring)) { + if (hgets (hstring, "RADECSYS", 31, systring)) + sprintf (radeckey, "RADECSYS"); + } + + if (eqstring[0] == 'J') { + wcs->equinox = atof (eqstring+1); + ieq = atoi (eqstring+1); + strcpy (systring, "FK5"); + } + else if (eqstring[0] == 'B') { + wcs->equinox = atof (eqstring+1); + ieq = (int) atof (eqstring+1); + strcpy (systring, "FK4"); + } + else if (hgeti4 (hstring, eqkey, &ieq)) { + hgetr8 (hstring, eqkey, &wcs->equinox); + eqhead = 1; + } + + else if (hgeti4 (hstring,"EPOCH",&ieq)) { + if (ieq == 0) { + ieq = 1950; + wcs->equinox = 1950.0; + } + else { + hgetr8 (hstring,"EPOCH",&wcs->equinox); + eqhead = 1; + } + } + + else if (systring[0] != (char)0) { + if (!strncmp (systring,"FK4",3)) { + wcs->equinox = 1950.0; + ieq = 1950; + } + else if (!strncmp (systring,"ICRS",4)) { + wcs->equinox = 2000.0; + ieq = 2000; + } + else if (!strncmp (systring,"FK5",3)) { + wcs->equinox = 2000.0; + ieq = 2000; + } + else if (!strncmp (systring,"GAL",3)) { + wcs->equinox = 2000.0; + ieq = 2000; + } + else if (!strncmp (systring,"ECL",3)) { + wcs->equinox = 2000.0; + ieq = 2000; + } + } + + if (ieq == 0) { + wcs->equinox = 2000.0; + ieq = 2000; + if (!strncmp (wcs->c1type, "RA",2) || !strncmp (wcs->c1type,"DEC",3)) + strcpy (systring,"FK5"); + } + + /* Epoch of image (from observation date, if possible) */ + if (!hgetdate (hstring,"DATE-OBS",&wcs->epoch)) { + if (!hgetdate (hstring,"DATE",&wcs->epoch)) { + if (!hgetr8 (hstring,"EPOCH",&wcs->epoch)) + wcs->epoch = wcs->equinox; + } + } + + /* Add time of day if not part of DATE-OBS string */ + else { + hgets (hstring,"DATE-OBS",32,tstring); + if (!strchr (tstring,'T')) { + if (hgetr8 (hstring, "UT",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + else if (hgetr8 (hstring, "UTMID",&ut)) + wcs->epoch = wcs->epoch + (ut / (24.0 * 365.242198781)); + } + } + if (wcs->epoch == 0.0) + wcs->epoch = wcs->equinox; + + /* Set coordinate system from keyword, if it is present */ + if (systring[0] == (char) 0) + hgets (hstring, radeckey, 31, systring); + if (systring[0] != (char) 0) { + strcpy (wcs->radecsys,systring); + if (!eqhead) { + if (!strncmp (wcs->radecsys,"FK4",3)) + wcs->equinox = 1950.0; + else if (!strncmp (wcs->radecsys,"FK5",3)) + wcs->equinox = 2000.0; + else if (!strncmp (wcs->radecsys,"ICRS",4)) + wcs->equinox = 2000.0; + else if (!strncmp (wcs->radecsys,"GAL",3) && ieq == 0) + wcs->equinox = 2000.0; + } + } + + /* Otherwise set coordinate system from equinox */ + /* Systemless coordinates cannot be translated using b, j, or g commands */ + else if (wcs->syswcs != WCS_NPOLE) { + if (ieq > 1980) + strcpy (wcs->radecsys,"FK5"); + else + strcpy (wcs->radecsys,"FK4"); + } + + /* Set galactic coordinates if GLON or GLAT are in C1TYPE */ + if (wcs->c1type[0] == 'G') + strcpy (wcs->radecsys,"GALACTIC"); + else if (wcs->c1type[0] == 'E') + strcpy (wcs->radecsys,"ECLIPTIC"); + else if (wcs->c1type[0] == 'S') + strcpy (wcs->radecsys,"SGALACTC"); + else if (wcs->c1type[0] == 'H') + strcpy (wcs->radecsys,"HELIOECL"); + else if (wcs->c1type[0] == 'A') + strcpy (wcs->radecsys,"ALTAZ"); + else if (wcs->c1type[0] == 'L') + strcpy (wcs->radecsys,"LINEAR"); + + wcs->syswcs = wcscsys (wcs->radecsys); + + return; +} + +/* Jun 11 1998 Split off header-dependent WCS initialization from other subs + * Jun 15 1998 Fix major bug in wcsinit() when synthesizing WCS from header + * Jun 18 1998 Fix bug in CD initialization; split PC initialization off + * Jun 18 1998 Split PC initialization off into subroutine wcspcset() + * Jun 24 1998 Set equinox from RADECSYS only if EQUINOX and EPOCH not present + * Jul 6 1998 Read third and fourth axis CTYPEs + * Jul 7 1998 Initialize eqin and eqout to equinox, + * Jul 9 1998 Initialize rotation matrices correctly + * Jul 13 1998 Initialize rotation, scale for polynomial and DSS projections + * Aug 6 1998 Fix CROTA computation for DSS projection + * Sep 4 1998 Fix CROTA, CDELT computation for DSS and polynomial projections + * Sep 14 1998 If DATE-OBS not found, check for DATE + * Sep 14 1998 If B or J present in EQUINOX, use that info to set system + * Sep 29 1998 Initialize additional WCS commands from the environment + * Sep 29 1998 Fix bug which read DATE as number rather than formatted date + * Dec 2 1998 Read projection constants from header (bug fix) + * + * Feb 9 1999 Set rotation angle correctly when using DSS projection + * Feb 19 1999 Fill in CDELTs from scale keyword if absent or zero + * Feb 19 1999 Add PIXSCALE as possible default arcseconds per pixel + * Apr 7 1999 Add error checking for NAXIS and NAXIS1 keywords + * Apr 7 1999 Do not set systring if epoch is 0 and not RA/Dec + * Jul 8 1999 In RADECSYS, use FK5 and FK4 instead of J2000 and B1950 + * Oct 15 1999 Free wcs using wcsfree() + * Oct 20 1999 Add multiple WCS support using new subroutine names + * Oct 21 1999 Delete unused variables after lint; declare dsspos() + * Nov 9 1999 Add wcschar() to check WCSNAME keywords for desired WCS + * Nov 9 1999 Check WCSPREx keyword to find out if chained WCS's + * + * Jan 6 1999 Add wcsinitn() to initialize from specific WCSNAME + * Jan 24 2000 Set CD matrix from header even if using polynomial + * Jan 27 2000 Fix MJD to epoch conversion for when MJD-OBS is the only date + * Jan 28 2000 Set CD matrix for DSS projection, too + * Jan 28 2000 Use wcsproj instead of oldwcs + * Dec 18 2000 Fix error in hgets() call in wcschar() + * Dec 29 2000 Compute inverse CD matrix even if polynomial solution + * Dec 29 2000 Add PROJR0 keyword for WCSLIB projections + * Dec 29 2000 Use CDi_j matrix if any elements are present + * + * Jan 31 2001 Fix to allow 1D WCS + * Jan 31 2001 Treat single character WCS name as WCS character + * Feb 20 2001 Implement WCSDEPx nested WCS's + * Feb 23 2001 Initialize all 4 terms of CD matrix + * Feb 28 2001 Fix bug which read CRPIX1 into CRPIX2 + * Mar 20 2001 Compare mchar to (char)0, not null + * Mar 21 2001 Move ic declaration into commented out code + * Jul 12 2001 Read PROJPn constants into proj.p array instead of PVn + * Sep 7 2001 Set system to galactic or ecliptic based on CTYPE, not RADECSYS + * Oct 11 2001 Set ctype[0] as well as ctype[1] to TAN for TNX projections + * Oct 19 2001 WCSDIM keyword overrides zero value of NAXIS + * + * Feb 19 2002 Add XPIXSIZE/YPIXSIZE (KPNO) as default image scale keywords + * Mar 12 2002 Add LONPOLE as well as LONGPOLE for WCSLIB 2.8 + * Apr 3 2002 Implement hget8c() and hgetsc() to simplify code + * Apr 3 2002 Add PVj_n projection constants in addition to PROJPn + * Apr 19 2002 Increase numeric keyword value length from 16 to 31 + * Apr 19 2002 Fix bug which didn't set radecsys keyword name + * Apr 24 2002 If no WCS present for specified letter, return null + * Apr 26 2002 Implement WCSAXESa keyword as first choice for number of axes + * Apr 26 2002 Add wcschar and wcsname to WCS structure + * May 9 2002 Add radvel and zvel to WCS structure + * May 13 2002 Free everything which is allocated + * May 28 2002 Read 10 prj.p instead of maximum of 100 + * May 31 2002 Fix bugs with PV reading + * May 31 2002 Initialize syswcs, sysin, sysout in wcsioset() + * Sep 25 2002 Fix subroutine calls for radvel and latpole + * Dec 6 2002 Correctly compute pixel at center of image for default CRPIX + * + * Jan 2 2002 Do not reinitialize projection vector for PV input + * Jan 3 2002 For ZPN, read PVi_0 to PVi_9, not PVi_1 to PVi_10 + * Mar 27 2003 Clean up default center computation + * Apr 3 2003 Add input for SIRTF distortion coefficients + * May 8 2003 Change PROJP reading to start with 0 instead of 1 + * May 22 2003 Add ZPX approximation, reading projpn from WATi + * May 28 2003 Avoid reinitializing coefficients set by PROJP + * Jun 26 2003 Initialize xref and yref to -999.0 + * Sep 23 2003 Change mgets() to mgetstr() to avoid name collision at UCO Lick + * Oct 1 2003 Rename wcs->naxes to wcs->naxis to match WCSLIB 3.2 + * Nov 3 2003 Initialize distortion coefficients in distortinit() in distort.c + * Dec 1 2003 Change p[0,1,2] initializations to p[1,2,3] + * Dec 3 2003 Add back wcs->naxes for backward compatibility + * Dec 3 2003 Remove unused variables j,m in wcsinitc() + * Dec 12 2003 Fix call to setwcserr() with format in it + * + * Feb 26 2004 Add parameters for ZPX projection + * + * Jun 22 2005 Drop declaration of variable wcserrmsg which is not used + * Nov 9 2005 Use CROTA1 if CTYPE1 is LAT/DEC, CROTA2 if CTYPE2 is LAT/DEC + * + * Mar 9 2006 Get Epoch of observation from MJD-OBS or DATE-OBS/UT unless DSS + * Apr 24 2006 Initialize rotation matrices + * Apr 25 2006 Ignore axes with dimension of one + * May 19 2006 Initialize all of 9x9 PC matrix; read in loops + * Aug 21 2006 Limit naxes to 2 everywhere; RA and DEC should always be 1st + * Oct 6 2006 If units are pixels, projection type is PIXEL + * Oct 30 2006 Initialize cube face to -1, not a cube projection + * + * Jan 4 2007 Drop declarations of wcsinitc() and wcsinitn() already in wcs.h + * Jan 8 2007 Change WCS letter from char to char* + * Feb 1 2007 Read IRAF log wavelength flag DC-FLAG to wcs.logwcs + * Feb 15 2007 Check for wcs->wcsproj > 0 instead of CTYPEi != LINEAR or PIXEL + * Mar 13 2007 Try for RA, DEC, SECPIX if WCS character is space or null + * Apr 27 2007 Ignore axes with TAB WCS for now + * Oct 17 2007 Fix bug testing &mchar instead of mchar in if statement + * + * May 9 2008 Initialize TNX projection when projection types first set + * Jun 27 2008 If NAXIS1 and NAXIS2 not present, check for IMAGEW and IMAGEH + * + * Mar 24 2009 Fix dimension bug if NAXISi not present (fix from John Burns) + * + * Mar 11 2011 Add NOAO ZPX projection (Frank Valdes) + * Mar 18 2011 Add invert_wcs() by Emmanuel Bertin for SCAMP + * Mar 18 2011 Change Bertin's ARCSEC/DEG to S2D and DEG/ARCSEC to D2S + * Sep 1 2011 Add TPV as TAN with SCAMP PVs + * + * Oct 19 2012 Drop unused variable iszpx; fix bug in latmin assignment + * + * Feb 1 2013 Externalize uppercase() + * Feb 07 2013 Avoid SWARP distortion if SIRTF distortion is present + * Jul 25 2013 Initialize n=0 when checking for SCAMP distortion terms (fix from Martin Kuemmel) + */ diff --git a/tksao/wcssubs/wcslib.c b/tksao/wcssubs/wcslib.c new file mode 100644 index 0000000..21c0593 --- /dev/null +++ b/tksao/wcssubs/wcslib.c @@ -0,0 +1,1334 @@ +/*============================================================================= +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* C routines which implement the FITS World Coordinate System (WCS) +* convention. +* +* Summary of routines +* ------------------- +* wcsfwd() and wcsrev() are high level driver routines for the WCS linear +* transformation, spherical coordinate transformation, and spherical +* projection routines. +* +* Given either the celestial longitude or latitude plus an element of the +* pixel coordinate a hybrid routine, wcsmix(), iteratively solves for the +* unknown elements. +* +* An initialization routine, wcsset(), computes indices from the ctype +* array but need not be called explicitly - see the explanation of +* wcs.flag below. +* +* +* Initialization routine; wcsset() +* -------------------------------- +* Initializes elements of a wcsprm data structure which holds indices into +* the coordinate arrays. Note that this routine need not be called directly; +* it will be invoked by wcsfwd() and wcsrev() if the "flag" structure member +* is anything other than a predefined magic value. +* +* Given: +* naxis const int +* Number of image axes. +* ctype[][9] +* const char +* Coordinate axis types corresponding to the FITS +* CTYPEn header cards. +* +* Returned: +* wcs wcsprm* Indices for the celestial coordinates obtained +* by parsing the ctype[] array (see below). +* +* Function return value: +* int Error status +* 0: Success. +* 1: Inconsistent or unrecognized coordinate axis +* types. +* +* +* Forward transformation; wcsfwd() +* -------------------------------- +* Compute the pixel coordinate for given world coordinates. +* +* Given: +* ctype[][9] +* const char +* Coordinate axis types corresponding to the FITS +* CTYPEn header cards. +* +* Given or returned: +* wcs wcsprm* Indices for the celestial coordinates obtained +* by parsing the ctype[] array (see below). +* +* Given: +* world const double[] +* World coordinates. world[wcs->lng] and +* world[wcs->lat] are the celestial longitude and +* latitude, in degrees. +* +* Given: +* crval const double[] +* Coordinate reference values corresponding to the FITS +* CRVALn header cards (see note 2). +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters (usage +* is described in the prologue to "cel.c"). +* +* Returned: +* phi, double* Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Given and returned: +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Returned: +* imgcrd double[] Image coordinate. imgcrd[wcs->lng] and +* imgcrd[wcs->lat] are the projected x-, and +* y-coordinates, in "degrees". For quadcube +* projections with a CUBEFACE axis the face number is +* also returned in imgcrd[wcs->cubeface]. +* +* Given and returned: +* lin linprm* Linear transformation parameters (usage is described +* in the prologue to "lin.c"). +* +* Returned: +* pixcrd double[] Pixel coordinate. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Invalid projection parameters. +* 3: Invalid world coordinate. +* 4: Invalid linear transformation parameters. +* +* +* Reverse transformation; wcsrev() +* -------------------------------- +* Compute world coordinates for a given pixel coordinate. +* +* Given: +* ctype[][9] +* const char +* Coordinate axis types corresponding to the FITS +* CTYPEn header cards. +* +* Given or returned: +* wcs wcsprm* Indices for the celestial coordinates obtained +* by parsing the ctype[] array (see below). +* +* Given: +* pixcrd const double[] +* Pixel coordinate. +* +* Given and returned: +* lin linprm* Linear transformation parameters (usage is described +* in the prologue to "lin.c"). +* +* Returned: +* imgcrd double[] Image coordinate. imgcrd[wcs->lng] and +* imgcrd[wcs->lat] are the projected x-, and +* y-coordinates, in "degrees". +* +* Given and returned: +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Returned: +* phi, double* Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Given: +* crval const double[] +* Coordinate reference values corresponding to the FITS +* CRVALn header cards (see note 2). +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters +* (usage is described in the prologue to "cel.c"). +* +* Returned: +* world double[] World coordinates. world[wcs->lng] and +* world[wcs->lat] are the celestial longitude and +* latitude, in degrees. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Invalid projection parameters. +* 3: Invalid pixel coordinate. +* 4: Invalid linear transformation parameters. +* +* +* Hybrid transformation; wcsmix() +* ------------------------------- +* Given either the celestial longitude or latitude plus an element of the +* pixel coordinate solve for the remaining elements by iterating on the +* unknown celestial coordinate element using wcsfwd(). +* +* Given: +* ctype[][9] +* const char +* Coordinate axis types corresponding to the FITS +* CTYPEn header cards. +* +* Given or returned: +* wcs wcsprm* Indices for the celestial coordinates obtained +* by parsing the ctype[] array (see below). +* +* Given: +* mixpix const int +* Which element of the pixel coordinate is given. +* mixcel const int +* Which element of the celestial coordinate is +* given: +* 1: Celestial longitude is given in +* world[wcs->lng], latitude returned in +* world[wcs->lat]. +* 2: Celestial latitude is given in +* world[wcs->lat], longitude returned in +* world[wcs->lng]. +* vspan[2] const double +* Solution interval for the celestial coordinate, in +* degrees. The ordering of the two limits is +* irrelevant. Longitude ranges may be specified with +* any convenient normalization, for example [-120,+120] +* is the same as [240,480], except that the solution +* will be returned with the same normalization, i.e. +* lie within the interval specified. +* vstep const double +* Step size for solution search, in degrees. If zero, +* a sensible, although perhaps non-optimal default will +* be used. +* viter int +* If a solution is not found then the step size will be +* halved and the search recommenced. viter controls +* how many times the step size is halved. The allowed +* range is 5 - 10. +* +* Given and returned: +* world double[] World coordinates. world[wcs->lng] and +* world[wcs->lat] are the celestial longitude and +* latitude, in degrees. Which is given and which +* returned depends on the value of mixcel. All other +* elements are given. +* +* Given: +* crval const double[] +* Coordinate reference values corresponding to the FITS +* CRVALn header cards (see note 2). +* +* Given and returned: +* cel celprm* Spherical coordinate transformation parameters +* (usage is described in the prologue to "cel.c"). +* +* Returned: +* phi, double* Longitude and latitude in the native coordinate +* theta system of the projection, in degrees. +* +* Given and returned: +* prj prjprm* Projection parameters (usage is described in the +* prologue to "proj.c"). +* +* Returned: +* imgcrd double[] Image coordinate. imgcrd[wcs->lng] and +* imgcrd[wcs->lat] are the projected x-, and +* y-coordinates, in "degrees". +* +* Given and returned: +* lin linprm* Linear transformation parameters (usage is described +* in the prologue to "lin.c"). +* +* Given and returned: +* pixcrd double[] Pixel coordinate. The element indicated by mixpix is +* given and the remaining elements are returned. +* +* Function return value: +* int Error status +* 0: Success. +* 1: Invalid coordinate transformation parameters. +* 2: Invalid projection parameters. +* 3: Coordinate transformation error. +* 4: Invalid linear transformation parameters. +* 5: No solution found in the specified interval. +* +* +* Notes +* ----- +* 1) The CTYPEn must in be upper case and there must be 0 or 1 pair of +* matched celestial axis types. The ctype[][9] should be padded with +* blanks on the right and null-terminated. +* +* 2) Elements of the crval[] array which correspond to celestial axes are +* ignored, the reference coordinate values in cel->ref[0] and +* cel->ref[1] are the ones used. +* +* 3) These functions recognize the NCP projection and convert it to the +* equivalent SIN projection. +* +* They also recognize GLS as a synonym for SFL. +* +* 4) The quadcube projections (TSC, CSC, QSC) may be represented in FITS in +* either of two ways: +* +* a) The six faces may be laid out in one plane and numbered as +* follows: +* +* 0 +* +* 4 3 2 1 4 3 2 +* +* 5 +* +* Faces 2, 3 and 4 may appear on one side or the other (or both). +* The forward routines map faces 2, 3 and 4 to the left but the +* inverse routines accept them on either side. +* +* b) The "COBE" convention in which the six faces are stored in a +* three-dimensional structure using a "CUBEFACE" axis indexed from +* 0 to 5 as above. +* +* These routines support both methods; wcsset() determines which is +* being used by the presence or absence of a CUBEFACE axis in ctype[]. +* wcsfwd() and wcsrev() translate the CUBEFACE axis representation to +* the single plane representation understood by the lower-level WCSLIB +* projection routines. +* +* +* WCS indexing parameters +* ----------------------- +* The wcsprm struct consists of the following: +* +* int flag +* The wcsprm struct contains indexes and other information derived +* from the CTYPEn. Whenever any of the ctype[] are set or changed +* this flag must be set to zero to signal the initialization routine, +* wcsset() to redetermine the indices. The flag is set to 999 if +* there is no celestial axis pair in the CTYPEn. +* +* char pcode[4] +* The WCS projection code. +* +* char lngtyp[5], lattyp[5] +* WCS celestial axis types. +* +* int lng,lat +* Indices into the imgcrd[], and world[] arrays as described above. +* These may also serve as indices for the celestial longitude and +* latitude axes in the pixcrd[] array provided that the PC matrix +* does not transpose axes. +* +* int cubeface +* Index into the pixcrd[] array for the CUBEFACE axis. This is +* optionally used for the quadcube projections where each cube face is +* stored on a separate axis. +* +* +* wcsmix() algorithm +* ------------------ +* Initially the specified solution interval is checked to see if it's a +* "crossing" interval. If it isn't, a search is made for a crossing +* solution by iterating on the unknown celestial coordinate starting at +* the upper limit of the solution interval and decrementing by the +* specified step size. A crossing is indicated if the trial value of the +* pixel coordinate steps through the value specified. If a crossing +* interval is found then the solution is determined by a modified form of +* "regula falsi" division of the crossing interval. If no crossing +* interval was found within the specified solution interval then a search +* is made for a "non-crossing" solution as may arise from a point of +* tangency. The process is complicated by having to make allowance for +* the discontinuities that occur in all map projections. +* +* Once one solution has been determined others may be found by subsequent +* invokations of wcsmix() with suitably restricted solution intervals. +* +* Note the circumstance which arises when the solution point lies at a +* native pole of a projection in which the pole is represented as a +* finite curve, for example the zenithals and conics. In such cases two +* or more valid solutions may exist but WCSMIX only ever returns one. +* +* Because of its generality wcsmix() is very compute-intensive. For +* compute-limited applications more efficient special-case solvers could +* be written for simple projections, for example non-oblique cylindrical +* projections. +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: wcslib.c,v 1.2 2016/03/30 20:09:45 joye Exp $ +*===========================================================================*/ + +#include <stdio.h> +#include <math.h> +#include <string.h> +#include <stdio.h> +#include "wcslib.h" + +/* Map error number to error message for each function. */ +const char *wcsset_errmsg[] = { + 0, + "Inconsistent or unrecognized coordinate axis types"}; + +const char *wcsfwd_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Invalid projection parameters", + "Invalid world coordinate", + "Invalid linear transformation parameters"}; + +const char *wcsrev_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Invalid projection parameters", + "Invalid pixel coordinate", + "Invalid linear transformation parameters"}; + +const char *wcsmix_errmsg[] = { + 0, + "Invalid coordinate transformation parameters", + "Invalid projection parameters", + "Coordinate transformation error", + "Invalid linear transformation parameters", + "No solution found in the specified interval"}; + +#define signb(X) ((X) < 0.0 ? 1 : 0) + +int +wcssett (naxis, ctype, wcs) + +const int naxis; +const char ctype[][9]; +struct wcsprm *wcs; + +{ + int nalias = 2; + char aliases [2][4] = {"NCP", "GLS"}; + + int j, k; + int *ndx = NULL; + char requir[9]; + + strcpy(wcs->pcode, ""); + strcpy(requir, ""); + wcs->lng = -1; + wcs->lat = -1; + wcs->cubeface = -1; + + for (j = 0; j < naxis; j++) { + if (ctype[j][4] != '-') { + if (strcmp(ctype[j], "CUBEFACE") == 0) { + if (wcs->cubeface == -1) { + wcs->cubeface = j; + } else { + /* Multiple CUBEFACE axes! */ + return 1; + } + } + continue; + } + + /* Got an axis qualifier, is it a recognized WCS projection? */ + for (k = 0; k < npcode; k++) { + if (strncmp(&ctype[j][5], pcodes[k], 3) == 0) break; + } + + if (k == npcode) { + /* Maybe it's a projection alias. */ + for (k = 0; k < nalias; k++) { + if (strncmp(&ctype[j][5], aliases[k], 3) == 0) break; + } + + /* Not recognized. */ + if (k == nalias) { + continue; + } + } + + /* Parse the celestial axis type. */ + if (strcmp(wcs->pcode, "") == 0) { + sprintf(wcs->pcode, "%.3s", &ctype[j][5]); + + if (strncmp(ctype[j], "RA--", 4) == 0) { + wcs->lng = j; + strcpy(wcs->lngtyp, "RA"); + strcpy(wcs->lattyp, "DEC"); + ndx = &wcs->lat; + sprintf(requir, "DEC--%s", wcs->pcode); + } else if (strncmp(ctype[j], "DEC-", 4) == 0) { + wcs->lat = j; + strcpy(wcs->lngtyp, "RA"); + strcpy(wcs->lattyp, "DEC"); + ndx = &wcs->lng; + sprintf(requir, "RA---%s", wcs->pcode); + } else if (strncmp(&ctype[j][1], "LON", 3) == 0) { + wcs->lng = j; + sprintf(wcs->lngtyp, "%cLON", ctype[j][0]); + sprintf(wcs->lattyp, "%cLAT", ctype[j][0]); + ndx = &wcs->lat; + sprintf(requir, "%s-%s", wcs->lattyp, wcs->pcode); + } else if (strncmp(&ctype[j][1], "LAT", 3) == 0) { + wcs->lat = j; + sprintf(wcs->lngtyp, "%cLON", ctype[j][0]); + sprintf(wcs->lattyp, "%cLAT", ctype[j][0]); + ndx = &wcs->lng; + sprintf(requir, "%s-%s", wcs->lngtyp, wcs->pcode); + } else if (strncmp(&ctype[j][2], "LN", 2) == 0) { + wcs->lng = j; + sprintf(wcs->lngtyp, "%c%cLN", ctype[j][0], ctype[j][1]); + sprintf(wcs->lattyp, "%c%cLT", ctype[j][0], ctype[j][1]); + ndx = &wcs->lat; + sprintf(requir, "%s-%s", wcs->lattyp, wcs->pcode); + } else if (strncmp(&ctype[j][2], "LT", 2) == 0) { + wcs->lat = j; + sprintf(wcs->lngtyp, "%c%cLN", ctype[j][0], ctype[j][1]); + sprintf(wcs->lattyp, "%c%cLT", ctype[j][0], ctype[j][1]); + ndx = &wcs->lng; + sprintf(requir, "%s-%s", wcs->lngtyp, wcs->pcode); + } else { + /* Unrecognized celestial type. */ + return 1; + } + } else { + if (strncmp(ctype[j], requir, 8) != 0) { + /* Inconsistent projection types. */ + return 1; + } + + if (ndx == NULL) + return 1; + *ndx = j; + strcpy(requir, ""); + } + } + + if (strcmp(requir, "")) { + /* Unmatched celestial axis. */ + return 1; + } + + /* Do simple alias translations. */ + if (strncmp(wcs->pcode, "GLS", 3) == 0) { + strcpy(wcs->pcode, "SFL"); + } + + if (strcmp(wcs->pcode, "")) { + wcs->flag = WCSSET; + } else { + /* Signal for no celestial axis pair. */ + wcs->flag = 999; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int +wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, imgcrd, lin, pixcrd) + +const char ctype[][9]; +struct wcsprm* wcs; +const double world[]; +const double crval[]; +struct celprm *cel; +double *phi, *theta; +struct prjprm *prj; +double imgcrd[]; +struct linprm *lin; +double pixcrd[]; + +{ + int err, j; + double offset; + + /* Initialize if required. */ + if (wcs->flag != WCSSET) { + if (wcssett(lin->naxis, ctype, wcs)) return 1; + } + + /* Convert to relative physical coordinates. */ + for (j = 0; j < lin->naxis; j++) { + if (j == wcs->lng) continue; + if (j == wcs->lat) continue; + imgcrd[j] = world[j] - crval[j]; + } + + if (wcs->flag != 999) { + /* Compute projected coordinates. */ + if (strcmp(wcs->pcode, "NCP") == 0) { + /* Convert NCP to SIN. */ + if (cel->ref[1] == 0.0) { + return 2; + } + + strcpy(wcs->pcode, "SIN"); + prj->p[1] = 0.0; + prj->p[2] = cosdeg (cel->ref[1])/sindeg (cel->ref[1]); + prj->flag = (prj->flag < 0) ? -1 : 0; + } + + if ((err = celfwd(wcs->pcode, world[wcs->lng], world[wcs->lat], cel, + phi, theta, prj, &imgcrd[wcs->lng], &imgcrd[wcs->lat]))) { + return err; + } + + /* Do we have a CUBEFACE axis? */ + if (wcs->cubeface != -1) { + /* Separation between faces. */ + if (prj->r0 == 0.0) { + offset = 90.0; + } else { + offset = prj->r0*PI/2.0; + } + + /* Stack faces in a cube. */ + if (imgcrd[wcs->lat] < -0.5*offset) { + imgcrd[wcs->lat] += offset; + imgcrd[wcs->cubeface] = 5.0; + } else if (imgcrd[wcs->lat] > 0.5*offset) { + imgcrd[wcs->lat] -= offset; + imgcrd[wcs->cubeface] = 0.0; + } else if (imgcrd[wcs->lng] > 2.5*offset) { + imgcrd[wcs->lng] -= 3.0*offset; + imgcrd[wcs->cubeface] = 4.0; + } else if (imgcrd[wcs->lng] > 1.5*offset) { + imgcrd[wcs->lng] -= 2.0*offset; + imgcrd[wcs->cubeface] = 3.0; + } else if (imgcrd[wcs->lng] > 0.5*offset) { + imgcrd[wcs->lng] -= offset; + imgcrd[wcs->cubeface] = 2.0; + } else { + imgcrd[wcs->cubeface] = 1.0; + } + } + } + + /* Apply forward linear transformation. */ + if (linfwd(imgcrd, lin, pixcrd)) { + return 4; + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int +wcsrevv(ctype, wcs, pixcrd, lin, imgcrd, prj, phi, theta, crval, cel, world) + +const char ctype[][9]; +struct wcsprm *wcs; +const double pixcrd[]; +struct linprm *lin; +double imgcrd[]; +struct prjprm *prj; +double *phi, *theta; +const double crval[]; +struct celprm *cel; +double world[]; + +{ + int err, face, j; + double offset; + + /* Initialize if required. */ + if (wcs->flag != WCSSET) { + if (wcssett(lin->naxis, ctype, wcs)) return 1; + } + + /* Apply reverse linear transformation. */ + if (linrev(pixcrd, lin, imgcrd)) { + return 4; + } + + /* Convert to world coordinates. */ + for (j = 0; j < lin->naxis; j++) { + if (j == wcs->lng) continue; + if (j == wcs->lat) continue; + world[j] = imgcrd[j] + crval[j]; + } + + + if (wcs->flag != 999) { + /* Do we have a CUBEFACE axis? */ + if (wcs->cubeface != -1) { + face = (int)(imgcrd[wcs->cubeface] + 0.5); + if (fabs(imgcrd[wcs->cubeface]-face) > 1e-10) { + return 3; + } + + /* Separation between faces. */ + if (prj->r0 == 0.0) { + offset = 90.0; + } else { + offset = prj->r0*PI/2.0; + } + + /* Lay out faces in a plane. */ + switch (face) { + case 0: + imgcrd[wcs->lat] += offset; + break; + case 1: + break; + case 2: + imgcrd[wcs->lng] += offset; + break; + case 3: + imgcrd[wcs->lng] += offset*2; + break; + case 4: + imgcrd[wcs->lng] += offset*3; + break; + case 5: + imgcrd[wcs->lat] -= offset; + break; + default: + return 3; + } + } + + /* Compute celestial coordinates. */ + if (strcmp(wcs->pcode, "NCP") == 0) { + /* Convert NCP to SIN. */ + if (cel->ref[1] == 0.0) { + return 2; + } + + strcpy(wcs->pcode, "SIN"); + prj->p[1] = 0.0; + prj->p[2] = cosdeg (cel->ref[1])/sindeg (cel->ref[1]); + prj->flag = (prj->flag < 0) ? -1 : 0; + } + + if ((err = celrev(wcs->pcode, imgcrd[wcs->lng], imgcrd[wcs->lat], prj, + phi, theta, cel, &world[wcs->lng], &world[wcs->lat]))) { + return err; + } + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ + +int +wcsmix(ctype, wcs, mixpix, mixcel, vspan, vstep, viter, world, crval, cel, + phi, theta, prj, imgcrd, lin, pixcrd) + +const char ctype[][9]; +struct wcsprm *wcs; +const int mixpix, mixcel; +const double vspan[2], vstep; +int viter; +double world[]; +const double crval[]; +struct celprm *cel; +double *phi, *theta; +struct prjprm *prj; +double imgcrd[]; +struct linprm *lin; +double pixcrd[]; + +{ + const int niter = 60; + int crossed, err, istep, iter, j, k, nstep, retry; + const double tol = 1.0e-10; + const double tol2 = 100.0*tol; + double lambda, span[2], step; + double pixmix; + double dlng, lng, lng0, lng0m, lng1, lng1m; + double dlat, lat, lat0, lat0m, lat1, lat1m; + double d, d0, d0m, d1, d1m; + double dx = 0.0; + double dabs, dmin, lmin; + double dphi, phi0, phi1; + struct celprm cel0; + + /* Initialize if required. */ + if (wcs->flag != WCSSET) { + if (wcssett(lin->naxis, ctype, wcs)) return 1; + } + + /* Check vspan. */ + if (vspan[0] <= vspan[1]) { + span[0] = vspan[0]; + span[1] = vspan[1]; + } else { + /* Swap them. */ + span[0] = vspan[1]; + span[1] = vspan[0]; + } + + /* Check vstep. */ + step = fabs(vstep); + if (step == 0.0) { + step = (span[1] - span[0])/10.0; + if (step > 1.0 || step == 0.0) step = 1.0; + } + + /* Check viter. */ + nstep = viter; + if (nstep < 5) { + nstep = 5; + } else if (nstep > 10) { + nstep = 10; + } + + /* Given pixel element. */ + pixmix = pixcrd[mixpix]; + + /* Iterate on the step size. */ + for (istep = 0; istep <= nstep; istep++) { + if (istep) step /= 2.0; + + /* Iterate on the sky coordinate between the specified range. */ + if (mixcel == 1) { + /* Celestial longitude is given. */ + + /* Check whether the solution interval is a crossing interval. */ + lat0 = span[0]; + world[wcs->lat] = lat0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d0 = pixcrd[mixpix] - pixmix; + + dabs = fabs(d0); + if (dabs < tol) return 0; + + lat1 = span[1]; + world[wcs->lat] = lat1; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d1 = pixcrd[mixpix] - pixmix; + + dabs = fabs(d1); + if (dabs < tol) return 0; + + lmin = lat1; + dmin = dabs; + + /* Check for a crossing point. */ + if (signb(d0) != signb(d1)) { + crossed = 1; + dx = d1; + } else { + crossed = 0; + lat0 = span[1]; + } + + for (retry = 0; retry < 4; retry++) { + /* Refine the solution interval. */ + while (lat0 > span[0]) { + lat0 -= step; + if (lat0 < span[0]) lat0 = span[0]; + world[wcs->lat] = lat0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0 = pixcrd[mixpix] - pixmix; + + /* Check for a solution. */ + dabs = fabs(d0); + if (dabs < tol) return 0; + + /* Record the point of closest approach. */ + if (dabs < dmin) { + lmin = lat0; + dmin = dabs; + } + + /* Check for a crossing point. */ + if (signb(d0) != signb(d1)) { + crossed = 2; + dx = d0; + break; + } + + /* Advance to the next subinterval. */ + lat1 = lat0; + d1 = d0; + } + + if (crossed) { + /* A crossing point was found. */ + for (iter = 0; iter < niter; iter++) { + /* Use regula falsi division of the interval. */ + lambda = d0/(d0-d1); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + + dlat = lat1 - lat0; + lat = lat0 + lambda*dlat; + world[wcs->lat] = lat; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + + /* Check for a solution. */ + d = pixcrd[mixpix] - pixmix; + dabs = fabs(d); + if (dabs < tol) return 0; + + if (dlat < tol) { + /* An artifact of numerical imprecision. */ + if (dabs < tol2) return 0; + + /* Must be a discontinuity. */ + break; + } + + /* Record the point of closest approach. */ + if (dabs < dmin) { + lmin = lat; + dmin = dabs; + } + + if (signb(d0) == signb(d)) { + lat0 = lat; + d0 = d; + } else { + lat1 = lat; + d1 = d; + } + } + + /* No convergence, must have been a discontinuity. */ + if (crossed == 1) lat0 = span[1]; + lat1 = lat0; + d1 = dx; + crossed = 0; + + } else { + /* No crossing point; look for a tangent point. */ + if (lmin == span[0]) break; + if (lmin == span[1]) break; + + lat = lmin; + lat0 = lat - step; + if (lat0 < span[0]) lat0 = span[0]; + lat1 = lat + step; + if (lat1 > span[1]) lat1 = span[1]; + + world[wcs->lat] = lat0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0 = fabs(pixcrd[mixpix] - pixmix); + + d = dmin; + + world[wcs->lat] = lat1; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d1 = fabs(pixcrd[mixpix] - pixmix); + + for (iter = 0; iter < niter; iter++) { + lat0m = (lat0 + lat)/2.0; + world[wcs->lat] = lat0m; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0m = fabs(pixcrd[mixpix] - pixmix); + + if (d0m < tol) return 0; + + lat1m = (lat1 + lat)/2.0; + world[wcs->lat] = lat1m; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d1m = fabs(pixcrd[mixpix] - pixmix); + + if (d1m < tol) return 0; + + if (d0m < d && d0m <= d1m) { + lat1 = lat; + d1 = d; + lat = lat0m; + d = d0m; + } else if (d1m < d) { + lat0 = lat; + d0 = d; + lat = lat1m; + d = d1m; + } else { + lat0 = lat0m; + d0 = d0m; + lat1 = lat1m; + d1 = d1m; + } + } + } + } + + } else { + /* Celestial latitude is given. */ + + /* Check whether the solution interval is a crossing interval. */ + lng0 = span[0]; + world[wcs->lng] = lng0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d0 = pixcrd[mixpix] - pixmix; + + dabs = fabs(d0); + if (dabs < tol) return 0; + + lng1 = span[1]; + world[wcs->lng] = lng1; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d1 = pixcrd[mixpix] - pixmix; + + dabs = fabs(d1); + if (dabs < tol) return 0; + lmin = lng1; + dmin = dabs; + + /* Check for a crossing point. */ + if (signb(d0) != signb(d1)) { + crossed = 1; + dx = d1; + } else { + crossed = 0; + lng0 = span[1]; + } + + for (retry = 0; retry < 4; retry++) { + /* Refine the solution interval. */ + while (lng0 > span[0]) { + lng0 -= step; + if (lng0 < span[0]) lng0 = span[0]; + world[wcs->lng] = lng0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0 = pixcrd[mixpix] - pixmix; + + /* Check for a solution. */ + dabs = fabs(d0); + if (dabs < tol) return 0; + + /* Record the point of closest approach. */ + if (dabs < dmin) { + lmin = lng0; + dmin = dabs; + } + + /* Check for a crossing point. */ + if (signb(d0) != signb(d1)) { + crossed = 2; + dx = d0; + break; + } + + /* Advance to the next subinterval. */ + lng1 = lng0; + d1 = d0; + } + + if (crossed) { + /* A crossing point was found. */ + for (iter = 0; iter < niter; iter++) { + /* Use regula falsi division of the interval. */ + lambda = d0/(d0-d1); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + + dlng = lng1 - lng0; + lng = lng0 + lambda*dlng; + world[wcs->lng] = lng; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + + /* Check for a solution. */ + d = pixcrd[mixpix] - pixmix; + dabs = fabs(d); + if (dabs < tol) return 0; + + if (dlng < tol) { + /* An artifact of numerical imprecision. */ + if (dabs < tol2) return 0; + + /* Must be a discontinuity. */ + break; + } + + /* Record the point of closest approach. */ + if (dabs < dmin) { + lmin = lng; + dmin = dabs; + } + + if (signb(d0) == signb(d)) { + lng0 = lng; + d0 = d; + } else { + lng1 = lng; + d1 = d; + } + } + + /* No convergence, must have been a discontinuity. */ + if (crossed == 1) lng0 = span[1]; + lng1 = lng0; + d1 = dx; + crossed = 0; + + } else { + /* No crossing point; look for a tangent point. */ + if (lmin == span[0]) break; + if (lmin == span[1]) break; + + lng = lmin; + lng0 = lng - step; + if (lng0 < span[0]) lng0 = span[0]; + lng1 = lng + step; + if (lng1 > span[1]) lng1 = span[1]; + + world[wcs->lng] = lng0; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0 = fabs(pixcrd[mixpix] - pixmix); + + d = dmin; + + world[wcs->lng] = lng1; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d1 = fabs(pixcrd[mixpix] - pixmix); + + for (iter = 0; iter < niter; iter++) { + lng0m = (lng0 + lng)/2.0; + world[wcs->lng] = lng0m; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d0m = fabs(pixcrd[mixpix] - pixmix); + + if (d0m < tol) return 0; + + lng1m = (lng1 + lng)/2.0; + world[wcs->lng] = lng1m; + if ((err = wcsfwd(ctype, wcs, world, crval, cel, phi, theta, + prj, imgcrd, lin, pixcrd))) { + return err; + } + d1m = fabs(pixcrd[mixpix] - pixmix); + + if (d1m < tol) return 0; + + if (d0m < d && d0m <= d1m) { + lng1 = lng; + d1 = d; + lng = lng0m; + d = d0m; + } else if (d1m < d) { + lng0 = lng; + d0 = d; + lng = lng1m; + d = d1m; + } else { + lng0 = lng0m; + d0 = d0m; + lng1 = lng1m; + d1 = d1m; + } + } + } + } + } + } + + + /* Set cel0 to the unity transformation. */ + cel0.flag = CELSET; + cel0.ref[0] = cel->ref[0]; + cel0.ref[1] = cel->ref[1]; + cel0.ref[2] = cel->ref[2]; + cel0.ref[3] = cel->ref[3]; + cel0.euler[0] = -90.0; + cel0.euler[1] = 0.0; + cel0.euler[2] = 90.0; + cel0.euler[3] = 1.0; + cel0.euler[4] = 0.0; + + /* No convergence, check for aberrant behaviour at a native pole. */ + *theta = -90.0; + for (j = 1; j <= 2; j++) { + /* Could the celestial coordinate element map to a native pole? */ + *theta = -*theta; + err = sphrev(0.0, *theta, cel->euler, &lng, &lat); + + if (mixcel == 1) { + if (fabs(fmod(world[wcs->lng]-lng,360.0)) > tol) continue; + if (lat < span[0]) continue; + if (lat > span[1]) continue; + world[wcs->lat] = lat; + } else { + if (fabs(world[wcs->lat]-lat) > tol) continue; + if (lng < span[0]) lng += 360.0; + if (lng > span[1]) lng -= 360.0; + if (lng < span[0]) continue; + if (lng > span[1]) continue; + world[wcs->lng] = lng; + } + + /* Is there a solution for the given pixel coordinate element? */ + lng = world[wcs->lng]; + lat = world[wcs->lat]; + + /* Feed native coordinates to wcsfwd() with cel0 set to unity. */ + world[wcs->lng] = -180.0; + world[wcs->lat] = *theta; + if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d0 = pixcrd[mixpix] - pixmix; + + /* Check for a solution. */ + if (fabs(d0) < tol) { + /* Recall saved world coordinates. */ + world[wcs->lng] = lng; + world[wcs->lat] = lat; + return 0; + } + + /* Search for a crossing interval. */ + phi0 = -180.0; + for (k = -179; k <= 180; k++) { + phi1 = (double) k; + world[wcs->lng] = phi1; + if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + d1 = pixcrd[mixpix] - pixmix; + + /* Check for a solution. */ + dabs = fabs(d1); + if (dabs < tol) { + /* Recall saved world coordinates. */ + world[wcs->lng] = lng; + world[wcs->lat] = lat; + return 0; + } + + /* Is it a crossing interval? */ + if (signb(d0) != signb(d1)) break; + + phi0 = phi1; + d0 = d1; + } + + for (iter = 1; iter <= niter; iter++) { + /* Use regula falsi division of the interval. */ + lambda = d0/(d0-d1); + if (lambda < 0.1) { + lambda = 0.1; + } else if (lambda > 0.9) { + lambda = 0.9; + } + + dphi = phi1 - phi0; + world[wcs->lng] = phi0 + lambda*dphi; + if ((err = wcsfwd(ctype, wcs, world, crval, &cel0, phi, theta, prj, + imgcrd, lin, pixcrd))) { + return err; + } + + /* Check for a solution. */ + d = pixcrd[mixpix] - pixmix; + dabs = fabs(d); + if (dabs < tol || (dphi < tol && dabs < tol2)) { + /* Recall saved world coordinates. */ + world[wcs->lng] = lng; + world[wcs->lat] = lat; + return 0; + } + + if (signb(d0) == signb(d)) { + phi0 = world[wcs->lng]; + d0 = d; + } else { + phi1 = world[wcs->lng]; + d1 = d; + } + } + } + + + /* No solution. */ + return 5; + +} +/* Dec 20 1999 Doug Mink - Change signbit() to signb() and always define it + * Dec 20 1999 Doug Mink - Include wcslib.h, which includes wcs.h, wcstrig.h + * + * Mar 20 2001 Doug Mink - Include stdio.h for sprintf() + * Mar 20 2001 Doug Mink - Add () around err assignments in if statements + * Sep 19 2001 Doug Mink - Add above changes to WCSLIB-2.7 version + * + * Mar 15 2002 Doug Mink - Add above changes to WCSLIB-2.8.2 + * Apr 3 2002 Mark Calabretta - Fix bug in code checking section + * + * Jun 20 2006 Doug Mink - Initialized uninitialized variables + */ diff --git a/tksao/wcssubs/wcslib.h b/tksao/wcssubs/wcslib.h new file mode 100644 index 0000000..b742653 --- /dev/null +++ b/tksao/wcssubs/wcslib.h @@ -0,0 +1,476 @@ +#ifndef wcslib_h_ +#define wcslib_h_ + +/*============================================================================= +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +* Author: Mark Calabretta, Australia Telescope National Facility +* $Id: wcslib.h,v 1.2 2016/03/30 20:09:45 joye Exp $ +*===========================================================================*/ + +#ifdef __cplusplus +extern "C" { +#endif + +#if !defined(__STDC__) && !defined(__cplusplus) +#ifndef const +#define const +#endif +#endif + +#define MAXPV 100 + +#define WCS_NGRIDPOINTS 12 /* Number of WCS grid points / axis */ +#define WCS_NGRIDPOINTS2 (WCS_NGRIDPOINTS*WCS_NGRIDPOINTS) +#define WCS_INVMAXDEG 9 /* Maximum inversion polynom degree */ +#define WCS_INVACCURACY 0.04 /* Maximum inversion error (pixels) */ +#define WCS_NRANGEPOINTS 32 /* Number of WCS range points / axis */ +#ifndef PI +#define PI 3.1415926535898 /* never met before? */ +#endif +/* DEG/ARCSEC is now D2S and ARCSEC/DEG is S2D */ +/* #define DEG (PI/180.0) 1 deg in radians */ +/* #define ARCSEC (DEG/3600.0) 1 arcsec in radians */ +#define NAXISPV 2 + +/* poly.h +*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +* Part of: A program using polynomial fits +* Author: E.BERTIN (IAP) +* Contents: Include for poly.c +* Last modified: 03/03/2004 +*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +*/ + +#ifndef _POLY_H_ +#define _POLY_H_ + +/*--------------------------------- constants -------------------------------*/ + +#define POLY_MAXDIM 4 /* Max dimensionality of polynom */ +#define POLY_MAXDEGREE 10 /* Max degree of the polynom */ + +/*---------------------------------- macros ---------------------------------*/ + +/*--------------------------- structure definitions -------------------------*/ + +typedef struct poly + { + double *basis; /* Current values of the basis functions */ + double *coeff; /* Polynom coefficients */ + int ncoeff; /* Number of coefficients */ + int *group; /* Groups */ + int ndim; /* dimensionality of the polynom */ + int *degree; /* Degree in each group */ + int ngroup; /* Number of different groups */ + } polystruct; + +/*---------------------------------- protos --------------------------------*/ + +extern polystruct *poly_init(int *group,int ndim,int *degree,int ngroup); + +extern double poly_func(polystruct *poly, double *pos); + +extern int cholsolve(double *a, double *b, int n), + *poly_powers(polystruct *poly); + +extern void poly_addcste(polystruct *poly, double *cste), + poly_end(polystruct *poly), + poly_fit(polystruct *poly, double *x, double *y, + double *w, int ndata, double *extbasis), + poly_solve(double *a, double *b, int n), + svdsolve(double *a, double *b, int m, int n, + double *vmat, double *wmat); + +#endif + +extern int npcode; +extern char pcodes[26][4]; + +struct prjprm { + char code[4]; + int flag; + double phi0, theta0; + double r0; + double p[10]; + double w[20]; + int n; + int npv; + double ppv[2*MAXPV]; + struct poly *inv_x; + struct poly *inv_y; + +#if __STDC__ || defined(__cplusplus) + int (*prjfwd)(const double, const double, + struct prjprm *, + double *, double *); + int (*prjrev)(const double, const double, + struct prjprm *, + double *, double *); +#else + int (*prjfwd)(); + int (*prjrev)(); +#endif +}; + +#if __STDC__ || defined(__cplusplus) + int prjset(const char [], struct prjprm *); + int prjfwd(const double, const double, struct prjprm *, double *, double *); + int prjrev(const double, const double, struct prjprm *, double *, double *); + int azpset(struct prjprm *); + int azpfwd(const double, const double, struct prjprm *, double *, double *); + int azprev(const double, const double, struct prjprm *, double *, double *); + int szpset(struct prjprm *); + int szpfwd(const double, const double, struct prjprm *, double *, double *); + int szprev(const double, const double, struct prjprm *, double *, double *); + int tanset(struct prjprm *); + int tanfwd(const double, const double, struct prjprm *, double *, double *); + int tanrev(const double, const double, struct prjprm *, double *, double *); + int stgset(struct prjprm *); + int stgfwd(const double, const double, struct prjprm *, double *, double *); + int stgrev(const double, const double, struct prjprm *, double *, double *); + int sinset(struct prjprm *); + int sinfwd(const double, const double, struct prjprm *, double *, double *); + int sinrev(const double, const double, struct prjprm *, double *, double *); + int arcset(struct prjprm *); + int arcfwd(const double, const double, struct prjprm *, double *, double *); + int arcrev(const double, const double, struct prjprm *, double *, double *); + int zpnset(struct prjprm *); + int zpnfwd(const double, const double, struct prjprm *, double *, double *); + int zpnrev(const double, const double, struct prjprm *, double *, double *); + int zeaset(struct prjprm *); + int zeafwd(const double, const double, struct prjprm *, double *, double *); + int zearev(const double, const double, struct prjprm *, double *, double *); + int airset(struct prjprm *); + int airfwd(const double, const double, struct prjprm *, double *, double *); + int airrev(const double, const double, struct prjprm *, double *, double *); + int cypset(struct prjprm *); + int cypfwd(const double, const double, struct prjprm *, double *, double *); + int cyprev(const double, const double, struct prjprm *, double *, double *); + int ceaset(struct prjprm *); + int ceafwd(const double, const double, struct prjprm *, double *, double *); + int cearev(const double, const double, struct prjprm *, double *, double *); + int carset(struct prjprm *); + int carfwd(const double, const double, struct prjprm *, double *, double *); + int carrev(const double, const double, struct prjprm *, double *, double *); + int merset(struct prjprm *); + int merfwd(const double, const double, struct prjprm *, double *, double *); + int merrev(const double, const double, struct prjprm *, double *, double *); + int sflset(struct prjprm *); + int sflfwd(const double, const double, struct prjprm *, double *, double *); + int sflrev(const double, const double, struct prjprm *, double *, double *); + int parset(struct prjprm *); + int parfwd(const double, const double, struct prjprm *, double *, double *); + int parrev(const double, const double, struct prjprm *, double *, double *); + int molset(struct prjprm *); + int molfwd(const double, const double, struct prjprm *, double *, double *); + int molrev(const double, const double, struct prjprm *, double *, double *); + int aitset(struct prjprm *); + int aitfwd(const double, const double, struct prjprm *, double *, double *); + int aitrev(const double, const double, struct prjprm *, double *, double *); + int copset(struct prjprm *); + int copfwd(const double, const double, struct prjprm *, double *, double *); + int coprev(const double, const double, struct prjprm *, double *, double *); + int coeset(struct prjprm *); + int coefwd(const double, const double, struct prjprm *, double *, double *); + int coerev(const double, const double, struct prjprm *, double *, double *); + int codset(struct prjprm *); + int codfwd(const double, const double, struct prjprm *, double *, double *); + int codrev(const double, const double, struct prjprm *, double *, double *); + int cooset(struct prjprm *); + int coofwd(const double, const double, struct prjprm *, double *, double *); + int coorev(const double, const double, struct prjprm *, double *, double *); + int bonset(struct prjprm *); + int bonfwd(const double, const double, struct prjprm *, double *, double *); + int bonrev(const double, const double, struct prjprm *, double *, double *); + int pcoset(struct prjprm *); + int pcofwd(const double, const double, struct prjprm *, double *, double *); + int pcorev(const double, const double, struct prjprm *, double *, double *); + int tscset(struct prjprm *); + int tscfwd(const double, const double, struct prjprm *, double *, double *); + int tscrev(const double, const double, struct prjprm *, double *, double *); + int cscset(struct prjprm *); + int cscfwd(const double, const double, struct prjprm *, double *, double *); + int cscrev(const double, const double, struct prjprm *, double *, double *); + int qscset(struct prjprm *); + int qscfwd(const double, const double, struct prjprm *, double *, double *); + int qscrev(const double, const double, struct prjprm *, double *, double *); + int raw_to_pv(struct prjprm *prj, double x, double y, double *xo, double *yo); +#else + int prjset(), prjfwd(), prjrev(); + int azpset(), azpfwd(), azprev(); + int szpset(), szpfwd(), szprev(); + int tanset(), tanfwd(), tanrev(); + int stgset(), stgfwd(), stgrev(); + int sinset(), sinfwd(), sinrev(); + int arcset(), arcfwd(), arcrev(); + int zpnset(), zpnfwd(), zpnrev(); + int zeaset(), zeafwd(), zearev(); + int airset(), airfwd(), airrev(); + int cypset(), cypfwd(), cyprev(); + int ceaset(), ceafwd(), cearev(); + int carset(), carfwd(), carrev(); + int merset(), merfwd(), merrev(); + int sflset(), sflfwd(), sflrev(); + int parset(), parfwd(), parrev(); + int molset(), molfwd(), molrev(); + int aitset(), aitfwd(), aitrev(); + int copset(), copfwd(), coprev(); + int coeset(), coefwd(), coerev(); + int codset(), codfwd(), codrev(); + int cooset(), coofwd(), coorev(); + int bonset(), bonfwd(), bonrev(); + int pcoset(), pcofwd(), pcorev(); + int tscset(), tscfwd(), tscrev(); + int cscset(), cscfwd(), cscrev(); + int qscset(), qscfwd(), qscrev(); + int raw_to_pv(); +#endif + + + +extern const char *prjset_errmsg[]; +extern const char *prjfwd_errmsg[]; +extern const char *prjrev_errmsg[]; + +#define PRJSET 137 + +struct celprm { + int flag; + double ref[4]; + double euler[5]; +}; + +#if __STDC__ || defined(__cplusplus) + int celset(const char *, struct celprm *, struct prjprm *); + int celfwd(const char *, + const double, const double, + struct celprm *, + double *, double *, + struct prjprm *, + double *, double *); + int celrev(const char *, + const double, const double, + struct prjprm *, + double *, double *, + struct celprm *, + double *, double *); +#else + int celset(), celfwd(), celrev(); +#endif + +extern const char *celset_errmsg[]; +extern const char *celfwd_errmsg[]; +extern const char *celrev_errmsg[]; + +#define CELSET 137 + +struct linprm { + int flag; + int naxis; + double *crpix; + double *pc; + double *cdelt; + + /* Intermediates. */ + double *piximg; + double *imgpix; +}; + +#if __STDC__ || defined(__cplusplus) + int linset(struct linprm *); + int linfwd(const double[], struct linprm *, double[]); + int linrev(const double[], struct linprm *, double[]); + int matinv(const int, const double [], double []); +#else + int linset(), linfwd(), linrev(), matinv(); +#endif + +extern const char *linset_errmsg[]; +extern const char *linfwd_errmsg[]; +extern const char *linrev_errmsg[]; + +#define LINSET 137 + + +struct wcsprm { + int flag; + char pcode[4]; + char lngtyp[5], lattyp[5]; + int lng, lat; + int cubeface; +}; + +#if __STDC__ || defined(__cplusplus) + int wcssett(const int, + const char[][9], + struct wcsprm *); + + int wcsfwd(const char[][9], + struct wcsprm *, + const double[], + const double[], + struct celprm *, + double *, + double *, + struct prjprm *, + double[], + struct linprm *, + double[]); + + int wcsrevv(const char[][9], + struct wcsprm *, + const double[], + struct linprm *, + double[], + struct prjprm *, + double *, + double *, + const double[], + struct celprm *, + double[]); + + int wcsmix(const char[][9], + struct wcsprm *, + const int, + const int, + const double[], + const double, + int, + double[], + const double[], + struct celprm *, + double *, + double *, + struct prjprm *, + double[], + struct linprm *, + double[]); + +#else + int wcsset(), wcsfwd(), wcsrev(), wcsmix(); +#endif + +extern const char *wcsset_errmsg[]; +extern const char *wcsfwd_errmsg[]; +extern const char *wcsrev_errmsg[]; +extern const char *wcsmix_errmsg[]; + +#define WCSSET 137 + + +#if __STDC__ || defined(__cplusplus) + int sphfwd(const double, const double, + const double [], + double *, double *); + int sphrev(const double, const double, + const double [], + double *, double *); +#else + int sphfwd(), sphrev(); +#endif + +#ifdef PI +#undef PI +#endif + +#ifdef D2R +#undef D2R +#endif + +#ifdef R2D +#undef R2D +#endif + +#ifdef SQRT2 +#undef SQRT2 +#endif + +#ifdef SQRT2INV +#undef SQRT2INV +#endif + +#ifdef D2S +#undef D2S +#endif + +#ifdef S2D +#undef S2D +#endif + +#define PI 3.141592653589793238462643 +#define D2R PI/180.0 +#define R2D 180.0/PI +#define S2D 1.0/3600.0 +#define D2S 3600.0 +#define SQRT2 1.4142135623730950488 +#define SQRT2INV 1.0/SQRT2 + +#if !defined(__STDC__) && !defined(__cplusplus) +#ifndef const +#define const +#endif +#endif + +#if __STDC__ || defined(__cplusplus) + double cosdeg(const double); + double sindeg(const double); + double tandeg(const double); + double acosdeg(const double); + double asindeg(const double); + double atandeg(const double); + double atan2deg(const double, const double); +#else + double cosdeg(); + double sindeg(); + double tandeg(); + double acosdeg(); + double asindeg(); + double atandeg(); + double atan2deg(); +#endif + +/* Domain tolerance for asin and acos functions. */ +#define WCSTRIG_TOL 1e-10 + +#ifdef __cplusplus +} +#endif + +#endif /* wcslib_h_ */ + +/* Feb 3 2000 Doug Mink - Make cplusplus ifdefs for braces all-inclusive + * + * Feb 15 2001 Doug Mink - Undefine math constants if already defined + * Sep 19 2001 Doug Mink - Update for WCSLIB 2.7, especially proj.h and cel.h + * + * Mar 12 2002 Doug Mink - Update for WCSLIB 2.8.2, especially proj.h + * Nov 29 2006 Doug Mink - Drop semicolon at end of C++ ifdef + * Jan 4 2007 Doug Mink - Drop extra declarations of SZP subroutines + * + * Mar 30 2011 Doug Mink - Add raw_to_pv() subroutine for SCAMP from Ed Los + */ diff --git a/tksao/wcssubs/wcstrig.c b/tksao/wcssubs/wcstrig.c new file mode 100644 index 0000000..064e662 --- /dev/null +++ b/tksao/wcssubs/wcstrig.c @@ -0,0 +1,189 @@ +/*============================================================================ +* +* WCSLIB - an implementation of the FITS WCS proposal. +* Copyright (C) 1995-2002, Mark Calabretta +* +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2 of the License, or (at your option) any later version. +* +* This library is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +* Lesser General Public License for more details. +* +* You should have received a copy of the GNU Lesser General Public +* License along with this library; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +* +* Correspondence concerning WCSLIB may be directed to: +* Internet email: mcalabre@atnf.csiro.au +* Postal address: Dr. Mark Calabretta, +* Australia Telescope National Facility, +* P.O. Box 76, +* Epping, NSW, 2121, +* AUSTRALIA +* +*============================================================================= +* +* The functions defined herein are trigonometric or inverse trigonometric +* functions which take or return angular arguments in decimal degrees. +* +* $Id: wcstrig.c,v 1.1.1.1 2016/03/30 20:00:02 joye Exp $ +*---------------------------------------------------------------------------*/ + +#include <math.h> +#include "wcslib.h" +const double d2r = PI / 180.0; +const double r2d = 180.0 / PI; + + +double cosdeg (angle) + +const double angle; + +{ + double resid; + + resid = fabs(fmod(angle,360.0)); + if (resid == 0.0) { + return 1.0; + } else if (resid == 90.0) { + return 0.0; + } else if (resid == 180.0) { + return -1.0; + } else if (resid == 270.0) { + return 0.0; + } + + return cos(angle*d2r); +} + +/*--------------------------------------------------------------------------*/ + +double sindeg (angle) + +const double angle; + +{ + double resid; + + resid = fmod(angle-90.0,360.0); + if (resid == 0.0) { + return 1.0; + } else if (resid == 90.0) { + return 0.0; + } else if (resid == 180.0) { + return -1.0; + } else if (resid == 270.0) { + return 0.0; + } + + return sin(angle*d2r); +} + +/*--------------------------------------------------------------------------*/ + +double tandeg (angle) + +const double angle; + +{ + double resid; + + resid = fmod(angle,360.0); + if (resid == 0.0 || fabs(resid) == 180.0) { + return 0.0; + } else if (resid == 45.0 || resid == 225.0) { + return 1.0; + } else if (resid == -135.0 || resid == -315.0) { + return -1.0; + } + + return tan(angle*d2r); +} + +/*--------------------------------------------------------------------------*/ + +double acosdeg(v) + +const double v; + +{ + if (v >= 1.0) { + if (v-1.0 < WCSTRIG_TOL) return 0.0; + } else if (v == 0.0) { + return 90.0; + } else if (v <= -1.0) { + if (v+1.0 > -WCSTRIG_TOL) return 180.0; + } + + return acos(v)*r2d; +} + +/*--------------------------------------------------------------------------*/ + +double asindeg (v) + +const double v; + +{ + if (v <= -1.0) { + if (v+1.0 > -WCSTRIG_TOL) return -90.0; + } else if (v == 0.0) { + return 0.0; + } else if (v >= 1.0) { + if (v-1.0 < WCSTRIG_TOL) return 90.0; + } + + return asin(v)*r2d; +} + +/*--------------------------------------------------------------------------*/ + +double atandeg (v) + +const double v; + +{ + if (v == -1.0) { + return -45.0; + } else if (v == 0.0) { + return 0.0; + } else if (v == 1.0) { + return 45.0; + } + + return atan(v)*r2d; +} + +/*--------------------------------------------------------------------------*/ + +double atan2deg (y, x) + +const double x, y; + +{ + if (y == 0.0) { + if (x >= 0.0) { + return 0.0; + } else if (x < 0.0) { + return 180.0; + } + } else if (x == 0.0) { + if (y > 0.0) { + return 90.0; + } else if (y < 0.0) { + return -90.0; + } + } + + return atan2(y,x)*r2d; +} +/* Dec 20 1999 Doug Mink - Change cosd() and sind() to cosdeg() and sindeg() + * Dec 20 1999 Doug Mink - Include wcslib.h, which includes wcstrig.h + * Dec 20 1999 Doug Mink - Use PI from wcslib.h, not locally defined + * + * Sep 19 2001 Doug Mink - No change for WCSLIB 2.7 + */ diff --git a/tksao/wcssubs/worldpos.c b/tksao/wcssubs/worldpos.c new file mode 100644 index 0000000..8693789 --- /dev/null +++ b/tksao/wcssubs/worldpos.c @@ -0,0 +1,693 @@ +/* worldpos.c -- WCS Algorithms from Classic AIPS. + * September 1, 2011 + * Copyright (C) 1994-2011 + * Associated Universities, Inc. Washington DC, USA. + * With code added by Jessica Mink, Smithsonian Astrophysical Observatory + * and Allan Brighton and Andreas Wicenec, ESO + * and Frank Valdes, NOAO + + * Module: worldpos.c + * Purpose: Perform forward and reverse WCS computations for 8 projections + * Subroutine: worldpos() converts from pixel location to RA,Dec + * Subroutine: worldpix() converts from RA,Dec to pixel location + + -=-=-=-=-=-=- + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning AIPS should be addressed as follows: + Internet email: aipsmail@nrao.edu + Postal address: AIPS Group + National Radio Astronomy Observatory + 520 Edgemont Road + Charlottesville, VA 22903-2475 USA + + -=-=-=-=-=-=- + + These two ANSI C functions, worldpos() and worldpix(), perform + forward and reverse WCS computations for 8 types of projective + geometries ("-SIN", "-TAN", "-ARC", "-NCP", "-GLS" or "-SFL", "-MER", + "-AIT", "-STG", "CAR", and "COE"): + + worldpos() converts from pixel location to RA,Dec + worldpix() converts from RA,Dec to pixel location + + where "(RA,Dec)" are more generically (long,lat). These functions + are based on the WCS implementation of Classic AIPS, an + implementation which has been in production use for more than ten + years. See the two memos by Eric Greisen + + ftp://fits.cv.nrao.edu/fits/documents/wcs/aips27.ps.Z + ftp://fits.cv.nrao.edu/fits/documents/wcs/aips46.ps.Z + + for descriptions of the 8 projective geometries and the + algorithms. Footnotes in these two documents describe the + differences between these algorithms and the 1993-94 WCS draft + proposal (see URL below). In particular, these algorithms support + ordinary field rotation, but not skew geometries (CD or PC matrix + cases). Also, the MER and AIT algorithms work correctly only for + CRVALi=(0,0). Users should note that GLS projections with yref!=0 + will behave differently in this code than in the draft WCS + proposal. The NCP projection is now obsolete (it is a special + case of SIN). WCS syntax and semantics for various advanced + features is discussed in the draft WCS proposal by Greisen and + Calabretta at: + + ftp://fits.cv.nrao.edu/fits/documents/wcs/wcs.all.ps.Z + + -=-=-=- + + The original version of this code was Emailed to D.Wells on + Friday, 23 September by Bill Cotton <bcotton@gorilla.cv.nrao.edu>, + who described it as a "..more or less.. exact translation from the + AIPSish..". Changes were made by Don Wells <dwells@nrao.edu> + during the period October 11-13, 1994: + 1) added GNU license and header comments + 2) added testpos.c program to perform extensive circularity tests + 3) changed float-->double to get more than 7 significant figures + 4) testpos.c circularity test failed on MER and AIT. B.Cotton + found that "..there were a couple of lines of code [in] the wrong + place as a result of merging several Fortran routines." + 5) testpos.c found 0h wraparound in worldpix() and worldpos(). + 6) E.Greisen recommended removal of various redundant if-statements, + and addition of a 360d difference test to MER case of worldpos(). + 7) D.Mink changed input to data structure and implemented rotation matrix. +*/ +#include <math.h> +#include <string.h> +#include <stdio.h> +#include "wcs.h" + +int +worldpos (xpix, ypix, wcs, xpos, ypos) + +/* Routine to determine accurate position for pixel coordinates */ +/* returns 0 if successful otherwise 1 = angle too large for projection; */ +/* does: -SIN, -TAN, -ARC, -NCP, -GLS or -SFL, -MER, -AIT projections */ +/* anything else is linear */ + +/* Input: */ +double xpix; /* x pixel number (RA or long without rotation) */ +double ypix; /* y pixel number (Dec or lat without rotation) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpos; /* x (RA) coordinate (deg) */ +double *ypos; /* y (dec) coordinate (deg) */ + +{ + double cosr, sinr, dx, dy, dz, tx; + double sins, coss, dt, l, m, mg, da, dd, cos0, sin0; + double rat = 0.0; + double dect = 0.0; + double mt, a, y0, td, r2; /* allan: for COE */ + double dec0, ra0, decout, raout; + double geo1, geo2, geo3; + double cond2r=1.745329252e-2; + double twopi = 6.28318530717959; + double deps = 1.0e-5; + + /* Structure elements */ + double xref; /* X reference coordinate value (deg) */ + double yref; /* Y reference coordinate value (deg) */ + double xrefpix; /* X reference pixel */ + double yrefpix; /* Y reference pixel */ + double xinc; /* X coordinate increment (deg) */ + double yinc; /* Y coordinate increment (deg) */ + double rot; /* Optical axis rotation (deg) (N through E) */ + int itype = wcs->prjcode; + + /* Set local projection parameters */ + xref = wcs->xref; + yref = wcs->yref; + xrefpix = wcs->xrefpix; + yrefpix = wcs->yrefpix; + xinc = wcs->xinc; + yinc = wcs->yinc; + rot = degrad (wcs->rot); + cosr = cos (rot); + sinr = sin (rot); + + /* Offset from ref pixel */ + dx = xpix - xrefpix; + dy = ypix - yrefpix; + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + tx = dx * wcs->cd[0] + dy * wcs->cd[1]; + dy = dx * wcs->cd[2] + dy * wcs->cd[3]; + dx = tx; + } + + /* Scale and rotate using CDELTn and CROTA2 */ + else { + + /* Check axis increments - bail out if either 0 */ + if ((xinc==0.0) || (yinc==0.0)) { + *xpos=0.0; + *ypos=0.0; + return 2; + } + + /* Scale using CDELT */ + dx = dx * xinc; + dy = dy * yinc; + + /* Take out rotation from CROTA */ + if (rot != 0.0) { + tx = dx * cosr - dy * sinr; + dy = dx * sinr + dy * cosr; + dx = tx; + } + } + + /* Flip coordinates if necessary */ + if (wcs->coorflip) { + tx = dx; + dx = dy; + dy = tx; + } + + /* Default, linear result for error or pixel return */ + *xpos = xref + dx; + *ypos = yref + dy; + if (itype <= 0) + return 0; + + /* Convert to radians */ + if (wcs->coorflip) { + dec0 = degrad (xref); + ra0 = degrad (yref); + } + else { + ra0 = degrad (xref); + dec0 = degrad (yref); + } + l = degrad (dx); + m = degrad (dy); + sins = l*l + m*m; + decout = 0.0; + raout = 0.0; + cos0 = cos (dec0); + sin0 = sin (dec0); + + /* Process by case */ + switch (itype) { + + case WCS_CAR: /* -CAR Cartesian (was WCS_PIX pixel and WCS_LIN linear) */ + rat = ra0 + l; + dect = dec0 + m; + break; + + case WCS_SIN: /* -SIN sin*/ + if (sins>1.0) return 1; + coss = sqrt (1.0 - sins); + dt = sin0 * coss + cos0 * m; + if ((dt>1.0) || (dt<-1.0)) return 1; + dect = asin (dt); + rat = cos0 * coss - sin0 * m; + if ((rat==0.0) && (l==0.0)) return 1; + rat = atan2 (l, rat) + ra0; + break; + + case WCS_TAN: /* -TAN tan */ + case WCS_TNX: /* -TNX tan with polynomial correction */ + case WCS_TPV: /* -TPV tan with polynomial correction */ + case WCS_ZPX: /* -ZPX zpn with polynomial correction */ + if (sins>1.0) return 1; + dect = cos0 - m * sin0; + if (dect==0.0) return 1; + rat = ra0 + atan2 (l, dect); + dect = atan (cos(rat-ra0) * (m * cos0 + sin0) / dect); + break; + + case WCS_ARC: /* -ARC Arc*/ + if (sins>=twopi*twopi/4.0) return 1; + sins = sqrt(sins); + coss = cos (sins); + if (sins!=0.0) sins = sin (sins) / sins; + else + sins = 1.0; + dt = m * cos0 * sins + sin0 * coss; + if ((dt>1.0) || (dt<-1.0)) return 1; + dect = asin (dt); + da = coss - dt * sin0; + dt = l * sins * cos0; + if ((da==0.0) && (dt==0.0)) return 1; + rat = ra0 + atan2 (dt, da); + break; + + case WCS_NCP: /* -NCP North celestial pole*/ + dect = cos0 - m * sin0; + if (dect==0.0) return 1; + rat = ra0 + atan2 (l, dect); + dt = cos (rat-ra0); + if (dt==0.0) return 1; + dect = dect / dt; + if ((dect>1.0) || (dect<-1.0)) return 1; + dect = acos (dect); + if (dec0<0.0) dect = -dect; + break; + + case WCS_GLS: /* -GLS global sinusoid */ + case WCS_SFL: /* -SFL Samson-Flamsteed */ + dect = dec0 + m; + if (fabs(dect)>twopi/4.0) return 1; + coss = cos (dect); + if (fabs(l)>twopi*coss/2.0) return 1; + rat = ra0; + if (coss>deps) rat = rat + l / coss; + break; + + case WCS_MER: /* -MER mercator*/ + dt = yinc * cosr + xinc * sinr; + if (dt==0.0) dt = 1.0; + dy = degrad (yref/2.0 + 45.0); + dx = dy + dt / 2.0 * cond2r; + dy = log (tan (dy)); + dx = log (tan (dx)); + geo2 = degrad (dt) / (dx - dy); + geo3 = geo2 * dy; + geo1 = cos (degrad (yref)); + if (geo1<=0.0) geo1 = 1.0; + rat = l / geo1 + ra0; + if (fabs(rat - ra0) > twopi) return 1; /* added 10/13/94 DCW/EWG */ + dt = 0.0; + if (geo2!=0.0) dt = (m + geo3) / geo2; + dt = exp (dt); + dect = 2.0 * atan (dt) - twopi / 4.0; + break; + + case WCS_AIT: /* -AIT Aitoff*/ + dt = yinc*cosr + xinc*sinr; + if (dt==0.0) dt = 1.0; + dt = degrad (dt); + dy = degrad (yref); + dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - + sin(dy)/sqrt((1.0+cos(dy))/2.0); + if (dx==0.0) dx = 1.0; + geo2 = dt / dx; + dt = xinc*cosr - yinc* sinr; + if (dt==0.0) dt = 1.0; + dt = degrad (dt); + dx = 2.0 * cos(dy) * sin(dt/2.0); + if (dx==0.0) dx = 1.0; + geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; + geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); + rat = ra0; + dect = dec0; + if ((l==0.0) && (m==0.0)) break; + dz = 4.0 - l*l/(4.0*geo1*geo1) - ((m+geo3)/geo2)*((m+geo3)/geo2) ; + if ((dz>4.0) || (dz<2.0)) return 1;; + dz = 0.5 * sqrt (dz); + dd = (m+geo3) * dz / geo2; + if (fabs(dd)>1.0) return 1;; + dd = asin (dd); + if (fabs(cos(dd))<deps) return 1;; + da = l * dz / (2.0 * geo1 * cos(dd)); + if (fabs(da)>1.0) return 1;; + da = asin (da); + rat = ra0 + 2.0 * da; + dect = dd; + break; + + case WCS_STG: /* -STG Sterographic*/ + dz = (4.0 - sins) / (4.0 + sins); + if (fabs(dz)>1.0) return 1; + dect = dz * sin0 + m * cos0 * (1.0+dz) / 2.0; + if (fabs(dect)>1.0) return 1; + dect = asin (dect); + rat = cos(dect); + if (fabs(rat)<deps) return 1; + rat = l * (1.0+dz) / (2.0 * rat); + if (fabs(rat)>1.0) return 1; + rat = asin (rat); + mg = 1.0 + sin(dect) * sin0 + cos(dect) * cos0 * cos(rat); + if (fabs(mg)<deps) return 1; + mg = 2.0 * (sin(dect) * cos0 - cos(dect) * sin0 * cos(rat)) / mg; + if (fabs(mg-m)>deps) rat = twopi/2.0 - rat; + rat = ra0 + rat; + break; + + case WCS_COE: /* COE projection code from Andreas Wicenic, ESO */ + td = tan (dec0); + y0 = 1.0 / td; + mt = y0 - m; + if (dec0 < 0.) + a = atan2 (l,-mt); + else + a = atan2 (l, mt); + rat = ra0 - (a / sin0); + r2 = (l * l) + (mt * mt); + dect = asin (1.0 / (sin0 * 2.0) * (1.0 + sin0*sin0 * (1.0 - r2))); + break; + } + + /* Return RA in range */ + raout = rat; + decout = dect; + if (raout-ra0>twopi/2.0) raout = raout - twopi; + if (raout-ra0<-twopi/2.0) raout = raout + twopi; + if (raout < 0.0) raout += twopi; /* added by DCW 10/12/94 */ + + /* Convert units back to degrees */ + *xpos = raddeg (raout); + *ypos = raddeg (decout); + + return 0; +} /* End of worldpos */ + + +int +worldpix (xpos, ypos, wcs, xpix, ypix) + +/*-----------------------------------------------------------------------*/ +/* routine to determine accurate pixel coordinates for an RA and Dec */ +/* returns 0 if successful otherwise: */ +/* 1 = angle too large for projection; */ +/* 2 = bad values */ +/* does: SIN, TAN, ARC, NCP, GLS or SFL, MER, AIT, STG, CAR, COE projections */ +/* anything else is linear */ + +/* Input: */ +double xpos; /* x (RA) coordinate (deg) */ +double ypos; /* y (dec) coordinate (deg) */ +struct WorldCoor *wcs; /* WCS parameter structure */ + +/* Output: */ +double *xpix; /* x pixel number (RA or long without rotation) */ +double *ypix; /* y pixel number (dec or lat without rotation) */ +{ + double dx, dy, ra0, dec0, ra, dec, coss, sins, dt, da, dd, sint; + double l, m, geo1, geo2, geo3, sinr, cosr, tx, x, a2, a3, a4; + double rthea,gamby2,a,b,c,phi,an,rap,v,tthea,co1,co2,co3,co4,ansq; /* COE */ + double cond2r=1.745329252e-2, deps=1.0e-5, twopi=6.28318530717959; + +/* Structure elements */ + double xref; /* x reference coordinate value (deg) */ + double yref; /* y reference coordinate value (deg) */ + double xrefpix; /* x reference pixel */ + double yrefpix; /* y reference pixel */ + double xinc; /* x coordinate increment (deg) */ + double yinc; /* y coordinate increment (deg) */ + double rot; /* Optical axis rotation (deg) (from N through E) */ + int itype; + + /* Set local projection parameters */ + xref = wcs->xref; + yref = wcs->yref; + xrefpix = wcs->xrefpix; + yrefpix = wcs->yrefpix; + xinc = wcs->xinc; + yinc = wcs->yinc; + rot = degrad (wcs->rot); + cosr = cos (rot); + sinr = sin (rot); + + /* Projection type */ + itype = wcs->prjcode; + + /* Nonlinear position */ + if (itype > 0) { + if (wcs->coorflip) { + dec0 = degrad (xref); + ra0 = degrad (yref); + dt = xpos - yref; + } + else { + ra0 = degrad (xref); + dec0 = degrad (yref); + dt = xpos - xref; + } + + /* 0h wrap-around tests added by D.Wells 10/12/1994: */ + /* Modified to exclude weird reference pixels by D.Mink 2/3/2004 */ + if (xrefpix*xinc > 180.0 || xrefpix*xinc < -180.0) { + if (dt > 360.0) xpos -= 360.0; + if (dt < 0.0) xpos += 360.0; + } + else { + if (dt > 180.0) xpos -= 360.0; + if (dt < -180.0) xpos += 360.0; + } + /* NOTE: changing input argument xpos is OK (call-by-value in C!) */ + + ra = degrad (xpos); + dec = degrad (ypos); + + /* Compute direction cosine */ + coss = cos (dec); + sins = sin (dec); + l = sin(ra-ra0) * coss; + sint = sins * sin(dec0) + coss * cos(dec0) * cos(ra-ra0); + } + else { + l = 0.0; + sint = 0.0; + sins = 0.0; + coss = 0.0; + ra = 0.0; + dec = 0.0; + ra0 = 0.0; + dec0 = 0.0; + m = 0.0; + } + + /* Process by case */ + switch (itype) { + + case WCS_CAR: /* -CAR Cartesian */ + l = ra - ra0; + m = dec - dec0; + break; + + case WCS_SIN: /* -SIN sin*/ + if (sint<0.0) return 1; + m = sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0); + break; + + case WCS_TNX: /* -TNX tan with polynomial correction */ + case WCS_TPV: /* -TPV tan with polynomial correction */ + case WCS_ZPX: /* -ZPX zpn with polynomial correction */ + case WCS_TAN: /* -TAN tan */ + if (sint<=0.0) return 1; + m = sins * sin(dec0) + coss * cos(dec0) * cos(ra-ra0); + l = l / m; + m = (sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0)) / m; + break; + + case WCS_ARC: /* -ARC Arc*/ + m = sins * sin(dec0) + coss * cos(dec0) * cos(ra-ra0); + if (m<-1.0) m = -1.0; + if (m>1.0) m = 1.0; + m = acos (m); + if (m!=0) + m = m / sin(m); + else + m = 1.0; + l = l * m; + m = (sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0)) * m; + break; + + case WCS_NCP: /* -NCP North celestial pole*/ + if (dec0==0.0) + return 1; /* can't stand the equator */ + else + m = (cos(dec0) - coss * cos(ra-ra0)) / sin(dec0); + break; + + case WCS_GLS: /* -GLS global sinusoid */ + case WCS_SFL: /* -SFL Samson-Flamsteed */ + dt = ra - ra0; + if (fabs(dec)>twopi/4.0) return 1; + if (fabs(dec0)>twopi/4.0) return 1; + m = dec - dec0; + l = dt * coss; + break; + + case WCS_MER: /* -MER mercator*/ + dt = yinc * cosr + xinc * sinr; + if (dt==0.0) dt = 1.0; + dy = degrad (yref/2.0 + 45.0); + dx = dy + dt / 2.0 * cond2r; + dy = log (tan (dy)); + dx = log (tan (dx)); + geo2 = degrad (dt) / (dx - dy); + geo3 = geo2 * dy; + geo1 = cos (degrad (yref)); + if (geo1<=0.0) geo1 = 1.0; + dt = ra - ra0; + l = geo1 * dt; + dt = dec / 2.0 + twopi / 8.0; + dt = tan (dt); + if (dt<deps) return 2; + m = geo2 * log (dt) - geo3; + break; + + case WCS_AIT: /* -AIT Aitoff*/ + l = 0.0; + m = 0.0; + da = (ra - ra0) / 2.0; + if (fabs(da)>twopi/4.0) return 1; + dt = yinc*cosr + xinc*sinr; + if (dt==0.0) dt = 1.0; + dt = degrad (dt); + dy = degrad (yref); + dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) - + sin(dy)/sqrt((1.0+cos(dy))/2.0); + if (dx==0.0) dx = 1.0; + geo2 = dt / dx; + dt = xinc*cosr - yinc* sinr; + if (dt==0.0) dt = 1.0; + dt = degrad (dt); + dx = 2.0 * cos(dy) * sin(dt/2.0); + if (dx==0.0) dx = 1.0; + geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx; + geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0); + dt = sqrt ((1.0 + cos(dec) * cos(da))/2.0); + if (fabs(dt)<deps) return 3; + l = 2.0 * geo1 * cos(dec) * sin(da) / dt; + m = geo2 * sin(dec) / dt - geo3; + break; + + case WCS_STG: /* -STG Sterographic*/ + da = ra - ra0; + if (fabs(dec)>twopi/4.0) return 1; + dd = 1.0 + sins * sin(dec0) + coss * cos(dec0) * cos(da); + if (fabs(dd)<deps) return 1; + dd = 2.0 / dd; + l = l * dd; + m = dd * (sins * cos(dec0) - coss * sin(dec0) * cos(da)); + break; + + case WCS_COE: /* allan: -COE projection added, AW, ESO*/ + gamby2 = sin (dec0); + tthea = tan (dec0); + rthea = 1. / tthea; + a = -2. * tthea; + b = tthea * tthea; + c = tthea / 3.; + a2 = a * a; + a3 = a2 * a; + a4 = a2 * a2; + co1 = a/2.; + co2 = -0.125 * a2 + b/2.; + co3 = -0.25 * a*b + 0.0625 * a3 + c/2.0; + co4 = -0.125 * b*b - 0.25 * a*c + 0.1875 * b*a2 - (5.0/128.0)*a4; + phi = ra0 - ra; + an = phi * gamby2; + v = dec - dec0; + rap = rthea * (1.0 + v * (co1+v * (co2+v * (co3+v * co4)))); + ansq = an * an; + if (wcs->rotmat) + l = rap * an * (1.0 - ansq/6.0) * (wcs->cd[0] / fabs(wcs->cd[0])); + else + l = rap * an * (1.0 - ansq/6.0) * (xinc / fabs(xinc)); + m = rthea - (rap * (1.0 - ansq/2.0)); + break; + + } /* end of itype switch */ + + /* Convert back to degrees */ + if (itype > 0) { + dx = raddeg (l); + dy = raddeg (m); + } + + /* For linear or pixel projection */ + else { + dx = xpos - xref; + dy = ypos - yref; + } + + if (wcs->coorflip) { + tx = dx; + dx = dy; + dy = tx; + } + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + tx = dx * wcs->dc[0] + dy * wcs->dc[1]; + dy = dx * wcs->dc[2] + dy * wcs->dc[3]; + dx = tx; + } + + /* Scale and rotate using CDELTn and CROTA2 */ + else { + + /* Correct for rotation */ + if (rot!=0.0) { + tx = dx*cosr + dy*sinr; + dy = dy*cosr - dx*sinr; + dx = tx; + } + + /* Scale using CDELT */ + if (xinc != 0.) + dx = dx / xinc; + if (yinc != 0.) + dy = dy / yinc; + } + + /* Convert to pixels */ + *xpix = dx + xrefpix; + if (itype == WCS_CAR) { + if (*xpix > wcs->nxpix) { + x = *xpix - (360.0 / xinc); + if (x > 0.0) *xpix = x; + } + else if (*xpix < 0) { + x = *xpix + (360.0 / xinc); + if (x <= wcs->nxpix) *xpix = x; + } + } + *ypix = dy + yrefpix; + + return 0; +} /* end worldpix */ + + +/* Oct 26 1995 Fix bug which interchanged RA and Dec twice when coorflip + * + * Oct 31 1996 Fix CD matrix use in WORLDPIX + * Nov 4 1996 Eliminate extra code for linear projection in WORLDPIX + * Nov 5 1996 Add coordinate flip in WORLDPIX + * + * May 22 1997 Avoid angle wraparound when CTYPE is pixel + * Jun 4 1997 Return without angle conversion from worldpos if type is PIXEL + * + * Oct 20 1997 Add chip rotation; compute rotation angle trig functions + * Jan 23 1998 Change PCODE to PRJCODE + * Jan 26 1998 Remove chip rotation code + * Feb 5 1998 Make cd[] and dc[] vectors; use xinc, yinc, rot from init + * Feb 23 1998 Add NOAO TNX projection as TAN + * Apr 28 1998 Change projection flags to WCS_* + * May 27 1998 Skip limit checking for linear projection + * Jun 25 1998 Fix inverse for CAR projection + * Aug 5 1998 Allan Brighton: Added COE projection (code from A. Wicenec, ESO) + * Sep 30 1998 Fix bug in COE inverse code to get sign correct + * + * Oct 21 1999 Drop unused y from worldpix() + * + * Apr 3 2002 Use GLS and SFL interchangeably + * + * Feb 3 2004 Let ra be >180 in worldpix() if ref pixel is >180 deg away + * + * Jun 20 2006 Initialize uninitialized variables + * + * Mar 11 2011 Initialize ZPX + * Sep 1 2011 Add TPV projection as TAN + */ diff --git a/tksao/wcssubs/zpxpos.c b/tksao/wcssubs/zpxpos.c new file mode 100644 index 0000000..a6f7168 --- /dev/null +++ b/tksao/wcssubs/zpxpos.c @@ -0,0 +1,735 @@ +/*** File wcslib/zpxpos.c + *** October 31, 2012 + *** By Frank Valdes, valdes@noao.edu + *** Modified from tnxpos.c by Jessica Mink, jmink@cfa.harvard.edu + *** Harvard-Smithsonian Center for Astrophysics + *** After IRAF mwcs/wfzpx.x + *** Copyright (C) 1998-2012 + *** Smithsonian Astrophysical Observatory, Cambridge, MA, USA + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + Correspondence concerning WCSTools should be addressed as follows: + Internet email: jmink@cfa.harvard.edu + Postal address: Jessica Mink + Smithsonian Astrophysical Observatory + 60 Garden St. + Cambridge, MA 02138 USA + */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <math.h> +#include "wcs.h" + +#define TOL 1e-13 +#define SPHTOL 0.00001 +#define BADCVAL 0.0 +#define MAX(a,b) (((a) > (b)) ? (a) : (b)) +#define MIN(a,b) (((a) < (b)) ? (a) : (b)) + +/* wfzpx -- wcs function driver for the zenithal / azimuthal polynomial. + * zpxinit (header, wcs) + * zpxclose (wcs) + * zpxfwd (xpix, ypix, wcs, xpos, ypos) Pixels to WCS + * zpxrev (xpos, ypos, wcs, xpix, ypix) WCS to pixels + */ + +#define max_niter 500 +#define SZ_ATSTRING 2000 +static void wf_gsclose(); + +/* zpxinit -- initialize the zenithal/azimuthal polynomial forward or + * inverse transform. initialization for this transformation consists of, + * determining which axis is ra / lon and which is dec / lat, computing the + * celestial longitude and colatitude of the native pole, reading in the the + * native longitude of the pole of the celestial coordinate system longpole + * from the attribute list, precomputing the euler angles and various + * intermediary functions of the reference coordinates, reading in the + * projection parameter ro from the attribute list, reading in up to ten + * polynomial coefficients, and, for polynomial orders greater than 2 computing + * the colatitude and radius of the first point of inflection. if longpole is + * undefined then a value of 180.0 degrees is assumed. if ro is undefined a + * value of 180.0 / pi is assumed. if the polynomial coefficients are all zero + * then an error condition is posted. if the order of the polynomial is 2 or + * greater and there is no point of inflection an error condition is posted. + * the zpx projection with an order of 1 and 0th and 1st coefficients of 0.0 + * and 1.0 respectively is equivalent to the arc projtection. in order to + * determine the axis order, the parameter "axtype={ra|dec} {xlon|xlat}" must + * have been set in the attribute list for the function. the longpole and ro + * parameters may be set in either or both of the axes attribute lists, but the + * value in the ra axis attribute list takes precedence. + */ + +int +zpxinit (header, wcs) + +const char *header; /* FITS header */ +struct WorldCoor *wcs; /* pointer to WCS structure */ +{ + int i, j; + struct IRAFsurface *wf_gsopen(); + char key[8], *str1, *str2, *lngstr, *latstr, *header1; + double zd1, d1, zd2,d2, zd, d, r; + extern void wcsrotset(); + + /* allocate space for the attribute strings */ + str1 = malloc (SZ_ATSTRING); + str2 = malloc (SZ_ATSTRING); + if (!hgetm (header, "WAT1", SZ_ATSTRING, str1)) { + /* this is a kludge to handle NOAO archived data where the first + * WAT cards are in the primary header and this code does not + * implement the inheritance convention. since zpx is largely an + * NOAO system and it doesn't make sense for WAT1 to be missing if + * ctype is ZPX, this block is only triggered with this kludge. + * there had to be a few changes to defeat the caching of the + * index of the header string so that the added cards are also + * found. + */ + + header1 = malloc (strlen(header)+200); + strcpy (header1, "WAT1_001= 'wtype=zpx axtype=ra projp0=0. projp1=1. projp2=0. projp3=337.74 proj'WAT2_001= 'wtype=zpx axtype=dec projp0=0. projp1=1. projp2=0. projp3=337.74 pro'"); + strcat (header1, header); + hgetm (header1, "WAT1", SZ_ATSTRING, str1); + hgetm (header1, "WAT2", SZ_ATSTRING, str2); + free (header1); + } + hgetm (header, "WAT2", SZ_ATSTRING, str2); + + lngstr = malloc (SZ_ATSTRING); + latstr = malloc (SZ_ATSTRING); + + /* determine the native longitude of the pole of the celestial + coordinate system corresponding to the FITS keyword longpole. + this number has no default and should normally be set to 180 + degrees. search both axes for this quantity. */ + + if (wcs->longpole > 360.0) { + if (!igetr8 (str1, "longpole", &wcs->longpole)) { + if (!igetr8 (str2, "longpole", &wcs->longpole)) + wcs->longpole = 180.0; + } + } + + /* Fetch the ro projection parameter which is the radius of the + generating sphere for the projection. if ro is absent which + is the usual case set it to 180 / pi. search both axes for + this quantity. */ + + if (!igetr8 (str1, "ro", &wcs->rodeg)) { + if (!igetr8 (str2, "ro", &wcs->rodeg)) + wcs->rodeg = 180.0 / PI; + } + + /* Fetch the zenithal polynomial coefficients. */ + for (i = 0; i < 10; i++) { + sprintf (key,"projp%d",i); + if (!igetr8 (str1, key, &wcs->prj.p[i])) + wcs->prj.p[i] = 0.0; + } + + /* Fetch the longitude correction surface. note that the attribute + string may be of any length so the length of atvalue may have + to be adjusted. */ + + if (!igets (str1, "lngcor", SZ_ATSTRING, lngstr)) { + if (!igets (str2, "lngcor", SZ_ATSTRING, lngstr)) + wcs->lngcor = NULL; + else + wcs->lngcor = wf_gsopen (lngstr); + } + else + wcs->lngcor = wf_gsopen (lngstr); + + /* Fetch the latitude correction surface. note that the attribute + string may be of any length so the length of atvalue may have + to be adjusted. */ + + if (!igets (str2, "latcor", SZ_ATSTRING, latstr)) { + if (!igets (str1, "latcor", SZ_ATSTRING, latstr)) + wcs->latcor = NULL; + else + wcs->latcor = wf_gsopen (latstr); + } + else + wcs->latcor = wf_gsopen (latstr); + + /* Determine the number of ZP coefficients */ + for (i = 9; i >= 0 && wcs->prj.p[i] == 0.; i--); + wcs->zpnp = i; + + if (i >= 3) { + /* Find the point of inflection closest to the pole. */ + zd1 = 0.; + d1 = wcs->prj.p[1]; + + /* Find the point where the derivative first goes negative. */ + for (i = 1; i<= 180; i++) { + zd2 = PI * i / 180.0; + d2 = 0.; + for (j = wcs->zpnp; j >= 1; j--) { + d2 = d2 * zd2 + j * wcs->prj.p[j]; + } + if (d2 <= 0.) + break; + zd1 = zd2; + d1 = d2; + } + + /* Find where the derivative is 0. */ + if (d2 <= 0.0) { + for (i = 1; i <= 10; i++) { + zd = zd1 - d1 * (zd2 - zd1) / (d2 - d1); + d = 0.; + for (j = wcs->zpnp; j >= 1; j--) { + d = d * zd + j * wcs->prj.p[j]; + } + if (fabs(d) < TOL) + break; + if (d < 0.) { + zd2 = zd; + d2 = d; + } + else { + zd1 = zd; + d1 = d; + } + } + } + + /* No negative derivative. */ + else + zd = PI; + + r = 0.; + for (j = wcs->zpnp; j >= 0; j--) + r = r * zd + wcs->prj.p[j]; + wcs->zpzd = zd; + wcs->zpr = r; + } + + /* Compute image rotation */ + wcsrotset (wcs); + + /* free working space. */ + free (str1); + free (str2); + free (lngstr); + free (latstr); + + /* Return 1 if there are no correction coefficients */ + if (wcs->latcor == NULL && wcs->lngcor == NULL) + return (1); + else + return (0); +} + + +/* zpxpos -- forward transform (physical to world) gnomonic projection. */ + +int +zpxpos (xpix, ypix, wcs, xpos, ypos) + +double xpix, ypix; /*i physical coordinates (x, y) */ +struct WorldCoor *wcs; /*i pointer to WCS descriptor */ +double *xpos, *ypos; /*o world coordinates (ra, dec) */ +{ + int i, j, k, ira, idec; + double x, y, r, phi, theta, costhe, sinthe, dphi, cosphi, sinphi, dlng, z; + double colatp, coslatp, sinlatp, longp; + double xs, ys, ra, dec, xp, yp; + double a, b, c, d, zd, zd1, zd2, r1, r2, rt, lambda; + double wf_gseval(); + + /* Convert from pixels to image coordinates */ + xpix = xpix - wcs->crpix[0]; + ypix = ypix - wcs->crpix[1]; + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + x = xpix * wcs->cd[0] + ypix * wcs->cd[1]; + y = xpix * wcs->cd[2] + ypix * wcs->cd[3]; + } + + else { + + /* Check axis increments - bail out if either 0 */ + if (wcs->cdelt[0] == 0.0 || wcs->cdelt[1] == 0.0) { + *xpos = 0.0; + *ypos = 0.0; + return 2; + } + + /* Scale using CDELT */ + xs = xpix * wcs->cdelt[0]; + ys = ypix * wcs->cdelt[1]; + + /* Take out rotation from CROTA */ + if (wcs->rot != 0.0) { + double cosr = cos (degrad (wcs->rot)); + double sinr = sin (degrad (wcs->rot)); + x = xs * cosr - ys * sinr; + y = xs * sinr + ys * cosr; + } + else { + x = xs; + y = ys; + } + } + + /* Get the axis numbers */ + if (wcs->coorflip) { + ira = 1; + idec = 0; + } + else { + ira = 0; + idec = 1; + } + colatp = degrad (90.0 - wcs->crval[idec]); + coslatp = cos(colatp); + sinlatp = sin(colatp); + longp = degrad(wcs->longpole); + + /* Compute native spherical coordinates phi and theta in degrees from the + projected coordinates. this is the projection part of the computation */ + k = wcs->zpnp; + if (wcs->lngcor != NULL) + xp = x + wf_gseval (wcs->lngcor, x, y); + else + xp = x; + if (wcs->latcor != NULL) + yp = y + wf_gseval (wcs->latcor, x, y); + else + yp = y; + x = xp; + y = yp; + r = sqrt (x * x + y * y) / wcs->rodeg; + + /* Solve */ + + /* Constant no solution */ + if (k < 1) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + + /* Linear */ + else if (k == 1) { + zd = (r - wcs->prj.p[0]) / wcs->prj.p[1]; + } + + /* Quadratic */ + else if (k == 2) { + + a = wcs->prj.p[2]; + b = wcs->prj.p[1]; + c = wcs->prj.p[0] - r; + d = b * b - 4. * a * c; + if (d < 0.) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + d = sqrt (d); + + /* Choose solution closest to the pole */ + zd1 = (-b + d) / (2. * a); + zd2 = (-b - d) / (2. * a); + if (zd1 < zd2) + zd = zd1; + else + zd = zd2; + if (zd < -TOL) { + if (zd1 > zd2) + zd = zd1; + else + zd = zd2; + } + if (zd < 0.) { + if (zd < -TOL) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + zd = 0.; + } + else if (zd > PI) { + if (zd > (PI + TOL)) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + zd = PI; + } + } + + /* Higher order solve iteratively */ + else { + + zd1 = 0.; + r1 = wcs->prj.p[0]; + zd2 = wcs->zpzd; + r2 = wcs->zpr; + + if (r < r1) { + if (r < (r1 - TOL)) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + zd = zd1; + } + else if (r > r2) { + if (r > (r2 + TOL)) { + *xpos = BADCVAL; + *ypos = BADCVAL; + return (1); + } + zd = zd2; + } + else { + for (j=0; j<100; j++) { + lambda = (r2 - r) / (r2 - r1); + if (lambda < 0.1) + lambda = 0.1; + else if (lambda > 0.9) + lambda = 0.9; + zd = zd2 - lambda * (zd2 - zd1); + rt = 0.; + for (i=k; i>=0; i--) + rt = (rt * zd) + wcs->prj.p[i]; + if (rt < r) { + if ((r - rt) < TOL) + break; + r1 = rt; + zd1 = zd; + } + else { + if ((rt - r) < TOL) + break; + r2 = rt; + zd2 = zd; + } + lambda = zd2 - zd1; + lambda = fabs (zd2 - zd1); + if (fabs (zd2 - zd1) < TOL) + break; + } + } + } + + /* Compute phi */ + if (r == 0.0) + phi = 0.0; + else + phi = atan2 (x, -y); + + /* Compute theta */ + theta = PI / 2 - zd; + + /* Compute the celestial coordinates ra and dec from the native + coordinates phi and theta. this is the spherical geometry part + of the computation */ + + costhe = cos (theta); + sinthe = sin (theta); + dphi = phi - longp; + cosphi = cos (dphi); + sinphi = sin (dphi); + + /* Compute the ra */ + x = sinthe * sinlatp - costhe * coslatp * cosphi; + if (fabs (x) < SPHTOL) + x = -cos (theta + colatp) + costhe * coslatp * (1.0 - cosphi); + y = -costhe * sinphi; + if (x != 0.0 || y != 0.0) + dlng = atan2 (y, x); + else + dlng = dphi + PI ; + ra = wcs->crval[ira] + raddeg(dlng); + + /* normalize ra */ + if (wcs->crval[ira] >= 0.0) { + if (ra < 0.0) + ra = ra + 360.0; + } + else { + if (ra > 0.0) + ra = ra - 360.0; + } + if (ra > 360.0) + ra = ra - 360.0; + else if (ra < -360.0) + ra = ra + 360.0; + + /* compute the dec */ + if (fmod (dphi, PI) == 0.0) { + dec = raddeg(theta + cosphi * colatp); + if (dec > 90.0) + dec = 180.0 - dec; + if (dec < -90.0) + dec = -180.0 - dec; + } + else { + z = sinthe * coslatp + costhe * sinlatp * cosphi; + if (fabs(z) > 0.99) { + if (z >= 0.0) + dec = raddeg(acos (sqrt(x * x + y * y))); + else + dec = raddeg(-acos (sqrt(x * x + y * y))); + } + else + dec = raddeg(asin (z)); + } + + /* store the results */ + *xpos = ra; + *ypos = dec; + return (0); +} + + +/* zpxpix -- inverse transform (world to physical) for the zenithal + * azimuthal polynomial projection. + */ + +int +zpxpix (xpos, ypos, wcs, xpix, ypix) + +double xpos, ypos; /*i world coordinates (ra, dec) */ +struct WorldCoor *wcs; /*i pointer to WCS descriptor */ +double *xpix, *ypix; /*o physical coordinates (x, y) */ +{ + int i, ira, idec, niter; + double ra, dec, cosdec, sindec, cosra, sinra, x, y, phi, theta; + double s, r, dphi, z, dpi, dhalfpi, twopi, tx; + double xm, ym, f, fx, fy, g, gx, gy, denom, dx, dy; + double colatp, coslatp, sinlatp, longp, sphtol; + double wf_gseval(), wf_gsder(); + + /* get the axis numbers */ + if (wcs->coorflip) { + ira = 1; + idec = 0; + } + else { + ira = 0; + idec = 1; + } + + /* Compute the transformation from celestial coordinates ra and + dec to native coordinates phi and theta. this is the spherical + geometry part of the transformation */ + + ra = degrad (xpos - wcs->crval[ira]); + dec = degrad (ypos); + cosra = cos (ra); + sinra = sin (ra); + cosdec = cos (dec); + sindec = sin (dec); + colatp = degrad (90.0 - wcs->crval[idec]); + coslatp = cos (colatp); + sinlatp = sin (colatp); + if (wcs->longpole == 999.0) + longp = degrad (180.0); + else + longp = degrad(wcs->longpole); + dpi = PI; + dhalfpi = dpi * 0.5; + twopi = PI + PI; + sphtol = SPHTOL; + + /* Compute phi */ + x = sindec * sinlatp - cosdec * coslatp * cosra; + if (fabs(x) < sphtol) + x = -cos (dec + colatp) + cosdec * coslatp * (1.0 - cosra); + y = -cosdec * sinra; + if (x != 0.0 || y != 0.0) + dphi = atan2 (y, x); + else + dphi = ra - dpi; + phi = longp + dphi; + if (phi > dpi) + phi = phi - twopi; + else if (phi < -dpi) + phi = phi + twopi; + + /* Compute theta */ + if (fmod (ra, dpi) == 0.0) { + theta = dec + cosra * colatp; + if (theta > dhalfpi) + theta = dpi - theta; + if (theta < -dhalfpi) + theta = -dpi - theta; + } + else { + z = sindec * coslatp + cosdec * sinlatp * cosra; + if (fabs (z) > 0.99) { + if (z >= 0.0) + theta = acos (sqrt(x * x + y * y)); + else + theta = -acos (sqrt(x * x + y * y)); + } + else + theta = asin (z); + } + + /* Compute the transformation from native coordinates phi and theta + to projected coordinates x and y */ + + s = dhalfpi - theta; + r = 0.; + for (i=9; i>=0; i--) + r = r * s + wcs->prj.p[i]; + r = wcs->rodeg * r; + + if (wcs->lngcor == NULL && wcs->latcor == NULL) { + if (wcs->coorflip) { + y = r * sin (phi); + x = -r * cos (phi); + } else { + x = r * sin (phi); + y = -r * cos (phi); + } + } else { + xm = r * sin (phi); + ym = -r * cos (phi); + x = xm; + y = ym; + niter = 0; + while (niter < max_niter) { + if (wcs->lngcor != NULL) { + f = x + wf_gseval (wcs->lngcor, x, y) - xm; + fx = wf_gsder (wcs->lngcor, x, y, 1, 0); + fx = 1.0 + fx; + fy = wf_gsder (wcs->lngcor, x, y, 0, 1); + } + else { + f = x - xm; + fx = 1.0 ; + fy = 0.0; + } + if (wcs->latcor != NULL) { + g = y + wf_gseval (wcs->latcor, x, y) - ym; + gx = wf_gsder (wcs->latcor, x, y, 1, 0); + gy = wf_gsder (wcs->latcor, x, y, 0, 1); + gy = 1.0 + gy; + } + else { + g = y - ym; + gx = 0.0 ; + gy = 1.0; + } + + denom = fx * gy - fy * gx; + if (denom == 0.0) + break; + dx = (-f * gy + g * fy) / denom; + dy = (-g * fx + f * gx) / denom; + x = x + dx; + y = y + dy; + if (MAX(MAX(fabs(dx),fabs(dy)),MAX(fabs(f),fabs(g))) < 2.80e-8) + break; + + niter = niter + 1; + } + + /* Reverse x and y if axes flipped */ + if (wcs->coorflip) { + tx = x; + x = y; + y = tx; + } + } + + /* Scale and rotate using CD matrix */ + if (wcs->rotmat) { + *xpix = x * wcs->dc[0] + y * wcs->dc[1]; + *ypix = x * wcs->dc[2] + y * wcs->dc[3]; + } + + else { + + /* Correct for rotation */ + if (wcs->rot!=0.0) { + double cosr = cos (degrad (wcs->rot)); + double sinr = sin (degrad (wcs->rot)); + *xpix = x * cosr + y * sinr; + *ypix = y * cosr - x * sinr; + } + else { + *xpix = x; + *ypix = y; + } + + /* Scale using CDELT */ + if (wcs->xinc != 0.) + *xpix = *xpix / wcs->xinc; + if (wcs->yinc != 0.) + *ypix = *ypix / wcs->yinc; + } + + /* Convert to pixels */ + *xpix = *xpix + wcs->xrefpix; + *ypix = *ypix + wcs->yrefpix; + + return (0); +} + + +/* ZPXCLOSE -- free up the distortion surface pointers */ + +void +zpxclose (wcs) + +struct WorldCoor *wcs; /* pointer to the WCS descriptor */ + +{ + if (wcs->lngcor != NULL) + wf_gsclose (wcs->lngcor); + if (wcs->latcor != NULL) + wf_gsclose (wcs->latcor); + return; +} + + +/* wf_gsclose -- procedure to free the surface descriptor */ + +static void +wf_gsclose (sf) + +struct IRAFsurface *sf; /* the surface descriptor */ + +{ + if (sf != NULL) { + if (sf->xbasis != NULL) + free (sf->xbasis); + if (sf->ybasis != NULL) + free (sf->ybasis); + if (sf->coeff != NULL) + free (sf->coeff); + free (sf); + } + return; +} + +/* + * Mar 8 2011 Created from tnxpos.c and wfzpx.x + * + * Oct 31 2012 End comment on line 346 after pole; fix code thereafter + */ |