*+ * Example 6: the code is extracted from SOFA Astrometry Tools Cookbook * Software version 10 * Document (Fortran) revision 1.2 * 2014 March 14 * * Copyright (C) 2014 IAU SOFA Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION AS2R PARAMETER ( AS2R = 4.848136811095359935899141D-6 ) DOUBLE PRECISION ASTROM(30) INTEGER J DOUBLE PRECISION PHI, ELONG, HM, PHPA, TC, RH, WL, : UTC1, UTC2, TAI1, TAI2, TT1, TT2, XP, YP, DUT1, : DX, DY, RC, DC, PR, PD, PX, RV, : EO, RI, DI, RCA, DCA, RA, DA, : AOT, ZOT, HOT, DOT, ROT, AOB, ZOB, HOB, DOB, ROB, : PVH(3,2), PVB(3,2), R(3,3), X, Y, S, B(8,3) DOUBLE PRECISION iau_ANP, iau_S06 * Site longitude, latitude (radians) and height above the geoid (m). CALL iau_AF2A ( '-', 5, 41, 54.2D0, ELONG, J ) IF ( J .NE. 0 ) STOP CALL iau_AF2A ( '-', 15, 57, 42.8D0, PHI, J ) IF ( J .NE. 0 ) STOP HM = 625D0 * Ambient pressure (HPa), temperature (C) and relative humidity (frac). PHPA = 952D0 TC = 18.5D0 RH = 0.83D0 * Effective color (microns). WL = 0.55D0 * UTC date. CALL iau_DTF2D ( 'UTC', 2013, 4, 2, 23, 15, 43.55D0, : UTC1, UTC2, J ) IF ( J .NE. 0 ) STOP * TT date. CALL iau_UTCTAI ( UTC1, UTC2, TAI1, TAI2, J ) IF ( J .NE. 0 ) STOP CALL iau_TAITT ( TAI1, TAI2, TT1, TT2, J ) IF ( J .NE. 0 ) STOP * EOPs: polar motion in radians, UT1-UTC in seconds. XP = 50.995D-3 * AS2R YP = 376.723D-3 * AS2R DUT1 = 155.0675D-3 * Corrections to IAU 2000A CIP (radians). DX = 0.269D-3 * AS2R DY = -0.274D-3 * AS2R * Star ICRS RA,Dec (radians). CALL iau_TF2A ( ' ', 14, 34, 16.81183D0, RC, J ) IF ( J .NE. 0 ) STOP CALL iau_AF2A ( '-', 12, 31, 10.3965D0, DC, J ) IF ( J .NE. 0 ) STOP CALL REPRD ( 'ICRS, epoch J2000.0:', RC, DC ) * Proper motion: RA/Dec derivatives, epoch J2000.0. PR = ATAN2 ( -354.45D-3 * AS2R, COS(DC) ) PD = 595.35D-3 * AS2R * Parallax (arcsec) and recession speed (km/s). PX = 164.99D-3 RV = 0D0 * ICRS to CIRS (geocentric observer). CALL iau_ATCI13 ( RC, DC, PR, PD, PX, RV, TT1, TT2, RI, DI, EO ) CALL REPRD ( 'catalog -> CIRS:', RI, DI ) * CIRS to ICRS (astrometric). CALL iau_ATIC13 ( RI, DI, TT1, TT2, RCA, DCA, EO ) CALL REPRD ( 'CIRS -> astrometric:', RCA, DCA ) * ICRS (astrometric) to CIRS (geocentric observer). CALL iau_ATCI13 ( RCA, DCA, 0D0, 0D0, 0D0, 0D0, TT1, TT2, : RI, DI, EO ) CALL REPRD ( 'astrometric -> CIRS:', RI, DI ) * Apparent place. RA = iau_ANP ( RI - EO ) DA = DI CALL REPRD ( 'geocentric apparent:', RA, DA ) * CIRS to topocentric. CALL iau_ATIO13 ( RI, DI, UTC1, UTC2, DUT1, ELONG, PHI, HM, : XP, YP, 0D0, 0D0, 0D0, 0D0, : AOT, ZOT, HOT, DOT, ROT, J ) IF ( J .NE. 0 ) STOP CALL REPRD ( 'CIRS -> topocentric:', ROT, DOT ) * CIRS to observed. CALL iau_ATIO13 ( RI, DI, UTC1, UTC2, DUT1, ELONG, PHI, HM, : XP, YP, PHPA, TC, RH, WL, : AOB, ZOB, HOB, DOB, ROB, J ) IF ( J .NE. 0 ) STOP CALL REPRD ( 'CIRS -> observed:', ROB, DOB ) * ICRS to observed. CALL iau_ATCO13 ( RC, DC, PR, PD, PX, RV, UTC1, UTC2, DUT1, : ELONG, PHI, HM, XP, YP, PHPA, TC, RH, WL, : AOB, ZOB, HOB, DOB, ROB, EO, J ) IF ( J .NE. 0 ) STOP CALL REPRD ( 'ICRS -> observed:', ROB, DOB ) * ICRS to CIRS using some user-supplied parameters. * JPL DE405 barycentric Earth ephemeris. CALL iau_EPV00 ( TT1, TT2, PVH, PVB, J ) IF ( J .NE. 0 ) STOP PVB(1,1) = -0.9741704366519668D0 PVB(2,1) = -0.2115201000882231D0 PVB(3,1) = -0.0917583114068277D0 PVB(1,2) = 0.0036436589347388D0 PVB(2,2) = -0.0154287318503146D0 PVB(3,2) = -0.0066892203821059D0 * IAU 2000A CIP. CALL iau_PNM00A ( TT1, TT2, R ) CALL iau_BPN2XY ( R, X, Y ) * Apply IERS corrections. X = X + DX Y = Y + DY * SOFA CIO locator. S = iau_S06 ( TT1, TT2, X, Y ) * Populate the context. CALL iau_APCI ( TT1, TT2, PVB, PVH, X, Y, S, ASTROM ) * Carry out the transformation and report the results. CALL iau_ATCIQ ( RC, DC, PR, PD, PX, RV, ASTROM, RI, DI ) CALL REPRD ( 'ICRS -> CIRS (JPL, IERS):', RI, DI ) * The same but with Saturn then Jupiter then Sun light deflection. B(1,1) = 0.00028574D0 B(2,1) = 3D-10 B(3,1) = -7.8101442680818964D0 B(4,1) = -5.6095668114887358D0 B(5,1) = -1.9807981923749924D0 B(6,1) = 0.0030723248971152D0 B(7,1) = -0.0040699547707598D0 B(8,1) = -0.0018133584165345D0 B(1,2) = 0.00095435D0 B(2,2) = 3D-9 B(3,2) = 0.7380987962351833D0 B(4,2) = 4.6365869247538951D0 B(5,2) = 1.9693136030111202D0 B(6,2) = -0.0075581692172088D0 B(7,2) = 0.0012691372216750D0 B(8,2) = 0.0007279990012801D0 B(1,3) = 1D0 B(2,3) = 6D-6 B(3,3) = -0.0007121743770509D0 B(4,3) = -0.0023047830339257D0 B(5,3) = -0.0010586596574639D0 B(6,3) = 0.0000062923521264D0 B(7,3) = -0.0000003308883872D0 B(8,3) = -0.0000002964866231D0 CALL iau_ATCIQN ( RC, DC, PR, PD, PX, RV, ASTROM, 3, B, RI, DI ) CALL REPRD ( 'ICRS -> CIRS (+ planets):', RI, DI ) * CIRS to ICRS (astrometric). CALL iau_ATICQN ( RI, DI, ASTROM, 3, B, RCA, DCA ) CALL REPRD ( 'CIRS -> astrometric:', RCA, DCA ) END SUBROUTINE REPRD ( S, RA, DC ) IMPLICIT NONE CHARACTER *(*) S DOUBLE PRECISION RA, DC CHARACTER PM INTEGER IHMSF(4), IDMSF(4) CALL iau_A2TF ( 7, RA, PM, IHMSF ) CALL iau_A2AF ( 6, DC, PM, IDMSF ) WRITE ( *, '(A25,3I3.2,''.'',I7.7,1X,A,I2.2,2I3.2,''.'',I6.6)' ) : S, IHMSF, PM, IDMSF END *+---------------------------------------------------------------------- * * Copyright (C) 2014 * Standards Of Fundamental Astronomy Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING SIX TERMS AND * CONDITIONS WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Board ("SOFA"). * * 2. Permission is granted to anyone to use the SOFA software for any * purpose, including commercial applications, free of charge and * without payment of royalties, subject to the conditions and * restrictions listed below. * * 3. You (the user) may copy and distribute SOFA source code to others, * and use and adapt its code and algorithms in your own software, * on a world-wide, royalty-free basis. That portion of your * distribution that does not consist of intact and unchanged copies * of SOFA source code files is a "derived work" that must comply * with the following requirements: * * a) Your work shall be marked or carry a statement that it * (i) uses routines and computations derived by you from * software provided by SOFA under license to you; and * (ii) does not itself constitute software provided by and/or * endorsed by SOFA. * * b) The source code of your derived work must contain descriptions * of how the derived work is based upon, contains and/or differs * from the original SOFA software. * * c) The names of all routines in your derived work shall not * include the prefix "iau" or "sofa" or trivial modifications * thereof such as changes of case. * * d) The origin of the SOFA components of your derived work must * not be misrepresented; you must not claim that you wrote the * original software, nor file a patent application for SOFA * software or algorithms embedded in the SOFA software. * * e) These requirements must be reproduced intact in any source * distribution and shall apply to anyone to whom you have * granted a further right to modify the source code of your * derived work. * * Note that, as originally distributed, the SOFA software is * intended to be a definitive implementation of the IAU standards, * and consequently third-party modifications are discouraged. All * variations, no matter how minor, must be explicitly marked as * such, as explained above. * * 4. You shall not cause the SOFA software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or * by inappropriate modification. * * 5. The SOFA software is provided "as is" and SOFA makes no warranty * as to its use or performance. SOFA does not and cannot warrant * the performance or results which the user may obtain by using the * SOFA software. SOFA makes no warranties, express or implied, as * to non-infringement of third party rights, merchantability, or * fitness for any particular purpose. In no event will SOFA be * liable to the user for any consequential, incidental, or special * damages, including any lost profits or lost savings, even if a * SOFA representative has been advised of such damages, or for any * claim by any third party. * * 6. The provision of any version of the SOFA software under the terms * and conditions specified herein does not imply that future * versions will also be made available under the same terms and * conditions. * * In any published work or commercial product which uses the SOFA * software directly, acknowledgement (see www.iausofa.org) is * appreciated. * * Correspondence concerning SOFA software should be addressed as * follows: * * By email: sofa@ukho.gov.uk * By post: IAU SOFA Center * HM Nautical Almanac Office * UK Hydrographic Office * Admiralty Way, Taunton * Somerset, TA1 2DN * United Kingdom * *-----------------------------------------------------------------------