c################################################################# subroutine dXdY2000_dpsideps1980(dmjd,dpsi,deps,dX,dY) c c Transformation of the celestial pole offsets (dpsi,deps)_1980 into c the celestial pole offsets (dX,dY)_2000 by using SOFA c matrix transformation recommanded by UAI 2000 (Wallace, 2006). c c c input dmjd : modified julian date c dpsi : celestial pole offset dpsi / UAI 1980 en mas c deps : --------------------- deps ----------------- c c output dX : celestial pole offset dX / UAI 2000 en mas c dY : --------------------- dY ------------------ c c Coded by Ch. Bizouard - December 2006 c##################################################################### implicit none real*8 dmjd,dpsi,deps,dX,dY real*8 psi,eps,epsa,RP(3,3),RN(3,3),R(3,3), : X1, Y1, X2, Y2,r2mas,dj0 double precision iau_OBL80 parameter ( dj0 = 2400000.5D0, : r2mas =206264.80624709635515647335733D3) * IAU 1976 precession matrix. CALL iau_PMAT76 ( dj0, dmjd, RP ) * IAU 1980 nutation components. CALL iau_NUT80 ( dj0, dmjd , psi, eps ) * Add nutation corrections. psi = psi + dpsi / r2mas eps = eps + deps / r2mas * Obliquity (IAU 1980). epsa = iau_OBL80 ( dj0, dmjd ) * Nutation matrix, with respect to IAU 1976 precession. CALL iau_NUMAT ( epsa, psi, eps, RN ) * Form observed precession-nutation matrix. CALL iau_RXR ( RN, RP, R ) * Extract observed CIP X,Y. CALL iau_BPN2XY ( R, X1, Y1 ) * ------------------------- * GCRS X,Y of IAU 2000A CIP * ------------------------- * IAU 2000A GCRS to CIRS matrix. CALL iau_C2I00A ( dj0, dmjd, R ) * Extract CIP X,Y. CALL iau_BPN2XY ( R, X2, Y2 ) * -------------- * Observed dX,dY * -------------- * Differences (mas). dX = r2mas * ( X1 - X2 ) dY = r2mas * ( Y1 - Y2 ) END c ############################################################################ subroutine dpsideps2000_dpsideps1980(dmjd,dpsi,deps,dpsi_2000,deps_2000) c c Transformation of the celestial pole offsets (dpsi,deps)_1980 into c the celestial pole offsets (dpsi,deps)_2000 by using SOFA c matrix transformation recommanded by UAI 2000 (Wallace, 2006). c c c input dmjd : modified julian date c dpsi : celestial pole offset dpsi / UAI 1980 en mas c deps : --------------------- deps ----------------- c c output dpsi_2000 : celestial pole offset dpsi / UAI 2000 en mas c deps_2000 : --------------------- deps ------------------ c c Coded by Ch. Bizouard - December 2006 c ########################################################################### implicit none real*8 dmjd,dpsi,deps,dX,dY real*8 psi,eps,epsa,RP(3,3),RN(3,3),R(3,3), : X1, Y1, X2, Y2,r2mas,dj0,dt real*8 pi,secrad,chi_A,psi_A,sineps0,coseps0,dpsi_2000,deps_2000 double precision iau_OBL80 parameter ( dj0 = 2400000.5D0, : r2mas =206264.80624709635515647335733D3) pi = 4.d0 * datan(1.d0) secrad = pi/180.d0/3600.d0 * IAU 1976 precession matrix. CALL iau_PMAT76 ( dj0, dmjd, RP ) * IAU 1980 nutation components. CALL iau_NUT80 ( dj0, dmjd , psi, eps ) * Add nutation corrections. psi = psi + dpsi / r2mas eps = eps + deps / r2mas * Obliquity (IAU 1980). epsa = iau_OBL80 ( dj0, dmjd ) * Nutation matrix, with respect to IAU 1976 precession. CALL iau_NUMAT ( epsa, psi, eps, RN ) * Form observed precession-nutation matrix. CALL iau_RXR ( RN, RP, R ) * Extract observed CIP X,Y. CALL iau_BPN2XY ( R, X1, Y1 ) * ------------------------- * GCRS X,Y of IAU 2000A CIP * ------------------------- * IAU 2000A GCRS to CIRS matrix. CALL iau_C2I00A ( dj0, dmjd, R ) * Extract CIP X,Y. CALL iau_BPN2XY ( R, X2, Y2 ) * -------------- * Observed dX,dY * -------------- * Differences (mas). dX = r2mas * ( X1 - X2 ) dY = r2mas * ( Y1 - Y2 ) call dpsideps2000_dXdY2000(dmjd,dX,dY,dpsi_2000,deps_2000) return end c ############################################################################ subroutine dpsideps2000_dXdY2000(dmjd,dX,dY,dpsi,deps) c c Transformation of the celestial pole offsets (dX,dY)_2000 into c the celestial pole offsets (dpsi,deps)_2000 by using SOFA c matrix transformation recommanded by UAI 2000 (Wallace, 2006). c c input dmjd : modified julian date c dX : celestial pole offset dX / UAI 2000 en mas c dY : --------------------- dY --------------- c c output dpsi : celestial pole offset dpsi / UAI 2000 en mas c deps : --------------------- deps ------------------ c c Coded by Ch. Bizouard - December 2006 c ########################################################################### implicit none real*8 dmjd,dX,dY real*8 psi,eps,epsa,RP(3,3),RN(3,3),R(3,3),X1, Y1, X2, Y2,r2mas,dj0,dt real*8 pi,secrad,chi_A,psi_A,sineps0,coseps0,dpsi,deps double precision iau_OBL80 parameter ( dj0 = 2400000.5D0,r2mas=206264.80624709635515647335733D3) pi = 4.d0 * datan(1.d0) secrad = pi/180.d0/3600.d0 dt = (DMJD - 51544.5d0)/36525.d0 ! julian century ! Luni-solar precession Psi_A = (5038.47875d0*dt - 1.07259d0*dt**2 -0.001147d0*dt**3)*secrad ! Planetary precession Chi_A = (10.5526d0*dt - 2.38064d0 * dt**2 -0.001125d0*dt**3)*secrad sineps0 = 0.3977771559319137D0 coseps0 = 0.9174820620691818D0 dpsi = (-dX + (Psi_A * coseps0 - Chi_A) *dY) & /(-(Psi_A * coseps0 - Chi_A)**2 * sineps0 - sineps0) deps = (-(Psi_A * coseps0 - Chi_A)*sineps0*dX - sineps0*dY) & /(-(Psi_A * coseps0 - Chi_A)**2 * sineps0 - sineps0) return end c################################################################# subroutine dpsideps1980_dXdY2000(dmjd,dX,dY,dpsi,deps) c c Transformation of the celestial pole offsets (dX,dY)_UAI2000 into c the celestial pole offsets (dpsi,deps)_UAI1980 by using SOFA c matrix transformation recommanded by UAI 2000 (Wallace, 2006). c c input dX : celestial pole offset dX / UAI 2000 en " c dY : --------------------- dY ------------------ c c output dmjd : modified julian date c dpsi : celestial pole offset dpsi / UAI 1980 en " c deps : --------------------- deps ----------------- c c c Coded by Ch. Bizouard - April 2007 c##################################################################### implicit none real*8 dmjd,dpsi,deps,dX,dY real*8 psi,eps,epsa,RP(3,3),RN(3,3),R(3,3),RB(3,3),RBP(3,3),RBPN(3,3), : X1, Y1, X2, Y2,r2mas,dj0 double precision iau_OBL80,eps2000,psi2000,deps_mod,dpsi_mod real*8 psi_A,chi_A,sineps0,coseps0,pi,secrad,dt parameter ( dj0 = 2400000.5D0,r2mas=206264.80624709635515647335733D3) * IAU 1980 nutation components. CALL iau_NUT80 ( dj0, dmjd , psi, eps ) ! en rad * IAU 2000 nutation components. CALL iau_NUT00A ( dj0, dmjd , psi2000, eps2000 ) ! en rad c call iau_PN00A ( dj0, DMJD, c : psi2000, eps2000, EPSA, RB, RP, RBP, RN, RBPN ) * difference de modele UAI 2000 - UAI 1980 dpsi_mod = (psi2000 - psi) * r2mas deps_mod = (eps2000 - eps) * r2mas pi = 4.d0 * datan(1.d0) secrad = pi/180.d0/3600.d0 dt = (DMJD - 51544.5d0)/36525.d0 ! julian century ! Luni-solar precession Psi_A = (5038.47875d0*dt - 1.07259d0*dt**2 -0.001147d0*dt**3)*secrad ! Planetary precession Chi_A = (10.5526d0*dt - 2.38064d0 * dt**2 -0.001125d0*dt**3)*secrad sineps0 = 0.3977771559319137D0 coseps0 = 0.9174820620691818D0 dX = dX * 1000.d0 dY = dY * 1000.d0 ! dpsi1980 / deps1980 dpsi = (-dX + (Psi_A * coseps0 - Chi_A) *dY) & /(-(Psi_A * coseps0 - Chi_A)**2 *sineps0 - sineps0) + dpsi_mod deps = (-(Psi_A * coseps0 - Chi_A)*sineps0*dX - sineps0*dY) & /(-(Psi_A * coseps0 - Chi_A)**2 *sineps0 - sineps0) + deps_mod DPSI = DPSI + (-2.9965d0) * dt * 100.d0 ! values of Herring / UAI 2000 DEPS = DEPS + (-0.2524d0) * dt * 100.d0 ! values of Herring / UAI 2000 DPSI = DPSI - 41.7750d0 + 40.d0 / 1d3 ! values of Herring / UAI 2000 corrigees DEPS = DEPS - 6.8192d0 - 40.d0 / 1d3 ! values of Herring / UAI 2000 corrigees dpsi = dpsi / 1000.d0 deps = deps / 1000.d0 END c################################################################# subroutine dpsideps1980_dpsideps2000(dmjd,dpsi2000,deps2000,dpsi,deps) c c Transformation of the celestial pole offsets (dpsi,deps)_UAI2000 into c the celestial pole offsets (dpsi,deps)_UAI1980 by using SOFA c matrix transformation recommanded by UAI 2000 (Wallace, 2006). c c input dpsi : celestial pole offset dpsi / UAI 2000 en " c deps : --------------------- deps ------------------ c c output dmjd : modified julian date c dpsi : celestial pole offset dpsi / UAI 1980 en " c deps : --------------------- deps ----------------- c c c Coded by Ch. Bizouard - April 2007 c##################################################################### implicit none real*8 dmjd,dpsi,deps,dpsi2000,deps2000 real*8 psi,eps,epsa,RP(3,3),RN(3,3),R(3,3),RB(3,3),RBP(3,3),RBPN(3,3), : X1, Y1, X2, Y2,r2mas,dj0 double precision iau_OBL80,eps2000,psi2000,deps_mod,dpsi_mod real*8 psi_A,chi_A,sineps0,coseps0,pi,secrad,dt parameter ( dj0 = 2400000.5D0, : r2mas =206264.80624709635515647335733D3) * IAU 1980 nutation components. CALL iau_NUT80 ( dj0, dmjd , psi, eps ) ! en rad * IAU 2000 nutation components. CALL iau_NUT00A ( dj0, dmjd , psi2000, eps2000 ) ! en rad * difference de modele UAI 2000 - UAI 1980 dpsi_mod = (psi2000 - psi) * r2mas deps_mod = (eps2000 - eps) * r2mas pi = 4.d0 * datan(1.d0) secrad = pi/180.d0/3600.d0 dt = (DMJD - 51544.5d0)/36525.d0 ! julian century dpsi = dpsi2000 * 1000.d0 + dpsi_mod deps = deps2000 * 1000.d0 + deps_mod DPSI = DPSI + (-2.9965d0) * dt * 100.d0 ! values of Herring / UAI 2000 DEPS = DEPS + (-0.2524d0) * dt * 100.d0 ! values of Herring / UAI 2000 DPSI = DPSI - 41.7750d0 ! values of Herring / UAI 2000 DEPS = DEPS - 6.8192d0 ! values of Herring / UAI 2000 dpsi = dpsi / 1000.d0 deps = deps / 1000.d0 END *----------------------------------------------------------------------* ! ============= ! SOFA ROUTINES ! ============= SUBROUTINE iau_C2I00A ( DATE1, DATE2, RC2I ) *+ * - - - - - - - - - - - * i a u _ C 2 I 0 0 A * - - - - - - - - - - - * * Form the celestial-to-intermediate matrix for a given date using the * IAU 2000A precession-nutation model. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * RC2I d(3,3) celestial-to-intermediate matrix (Note 2) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The matrix RC2I is the first stage in the transformation from * celestial to terrestrial coordinates: * * [TRS] = RPOM * R_3(ERA) * RC2I * [CRS] * * = RC2T * [CRS] * * where [CRS] is a vector in the Geocentric Celestial Reference * System and [TRS] is a vector in the International Terrestrial * Reference System (see IERS Conventions 2000), ERA is the Earth * Rotation Angle and RPOM is the polar motion matrix. * * 3) A faster, but slightly less accurate result (about 1 mas), can be * obtained by using instead the iau_C2I00B routine. * * Called: * iau_PNM00A classical bias-precession-nutation matrix, IAU 2000A * iau_C2IBPN celestial-to-intermediate matrix given BPN matrix * * References: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * McCarthy, D.D., IERS Conventions 2000, Chapter 5 (2002). * * This revision: 2002 November 11 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, RC2I(3,3) DOUBLE PRECISION RBPN(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Obtain the celestial-to-true matrix (IAU 2000A). CALL iau_PNM00A ( DATE1, DATE2, RBPN ) * Form the celestial-to-intermediate matrix. CALL iau_C2IBPN ( DATE1, DATE2, RBPN, RC2I ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_BPN2XY ( RBPN, X, Y ) *+ * - - - - - - - - - - - * i a u _ B P N 2 X Y * - - - - - - - - - - - * * Extract from the bias-precession-nutation matrix the X,Y coordinates * of the Celestial Intermediate Pole. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * RBPN d(3,3) celestial-to-true matrix (Note 1) * * Returned: * X,Y d Celestial Intermediate Pole (Note 2) * * Notes: * * 1) The matrix RBPN transforms vectors from GCRS to true of date * (CIP/equinox), and so the Celestial Intermediate Pole unit vector * is the bottom row of the matrix. * * 2) X,Y are components of the Celestial Intermediate Pole unit vector * in the Geocentric Celestial Reference System. * * Reference: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * This revision: 2002 November 9 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION RBPN(3,3), X, Y * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Extract the X,Y coordinates. X = RBPN(3,1) Y = RBPN(3,2) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_RXR ( A, B, ATB ) *+ * - - - - - - - - * i a u _ R X R * - - - - - - - - * * Multiply two r-matrices. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * A d(3,3) first r-matrix * B d(3,3) second r-matrix * * Returned: * ATB d(3,3) A * B * * Called: * iau_CR copy r-matrix * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION A(3,3), B(3,3), ATB(3,3) INTEGER I, J, K DOUBLE PRECISION W, WM(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO 3 I=1,3 DO 2 J=1,3 W = 0D0 DO 1 K=1,3 W = W + A(I,K)*B(K,J) 1 CONTINUE WM(I,J) = W 2 CONTINUE 3 CONTINUE CALL iau_CR ( WM, ATB ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_NUMAT ( EPSA, DPSI, DEPS, RMATN ) *+ * - - - - - - - - - - * i a u _ N U M A T * - - - - - - - - - - * * Form the matrix of nutation. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * EPSA d mean obliquity of date (Note 1) * DPSI,DEPS d nutation (Note 2) * * Returned: * RMATN d(3,3) nutation matrix (Note 3) * * Notes: * * * 1) The supplied mean obliquity EPSA, must be consistent with the * precession-nutation models from which DPSI and DEPS were obtained. * * 2) The caller is responsible for providing the nutation components; * they are in longitude and obliquity, in radians and are with * respect to the equinox and ecliptic of date. * * 3) The matrix operates in the sense V(true) = RMATN * V(mean), * where the p-vector V(true) is with respect to the true * equatorial triad of date and the p-vector V(mean) is with * respect to the mean equatorial triad of date. * * Called: * iau_IR initialize r-matrix to identity * iau_RX rotate around X-axis * iau_RZ rotate around Z-axis * * Reference: * * Explanatory Supplement to the Astronomical Almanac, * P. Kenneth Seidelmann (ed), University Science Books (1992), * Section 3.222-3 (p114). * * This revision: 2002 December 24 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION EPSA, DPSI, DEPS, RMATN(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Build the rotation matrix. CALL iau_IR ( RMATN ) CALL iau_RX ( EPSA, RMATN ) CALL iau_RZ ( -DPSI, RMATN ) CALL iau_RX ( -(EPSA+DEPS), RMATN ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_NUT80 ( EPOCH1, EPOCH2, DPSI, DEPS ) *+ * - - - - - - - - - - * i a u _ N U T 8 0 * - - - - - - - - - - * * Nutation, IAU 1980 model. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * EPOCH1,EPOCH2 d TDB starting epoch (Note 1) * * Returned: * DPSI d nutation in longitude (radians) * DEPS d nutation in obliquity (radians) * * Notes: * * 1) The epoch EPOCH1+EPOCH2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TDB)=2450123.7 could be expressed in any of these ways, * among others: * * EPOCH1 EPOCH2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The nutation components are with respect to the ecliptic of * date. * * Called: * iau_ANP normalize radians to range -pi to +pi * * Reference: * * Explanatory Supplement to the Astronomical Almanac, * P. Kenneth Seidelmann (ed), University Science Books (1992), * Section 3.222 (p111). * * This revision: 2001 September 16 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION EPOCH1, EPOCH2, DPSI, DEPS * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * 2Pi DOUBLE PRECISION D2PI PARAMETER ( D2PI = 6.283185307179586476925287D0 ) * Units of 0.1 milliarcsecond to radians DOUBLE PRECISION U2R PARAMETER ( U2R = DAS2R/1D4 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) DOUBLE PRECISION T, EL, ELP, F, D, OM, DP, DE, ARG, S, C INTEGER I, J DOUBLE PRECISION iau_ANPM * ------------------------------------------------ * Table of multiples of arguments and coefficients * ------------------------------------------------ * * The coefficient values are in 0.1 mas units and the rates of change * are in mas per Julian millennium. REAL X(9,106) * Multiple of Longitude Obliquity * L L' F D Omega coeff. of sin coeff. of cos DATA ((X(I,J),I=1,9),J=1,10) / : 0., 0., 0., 0., 1., -171996., -1742., 92025., 89., : 0., 0., 0., 0., 2., 2062., 2., -895., 5., : -2., 0., 2., 0., 1., 46., 0., -24., 0., : 2., 0., -2., 0., 0., 11., 0., 0., 0., : -2., 0., 2., 0., 2., -3., 0., 1., 0., : 1., -1., 0., -1., 0., -3., 0., 0., 0., : 0., -2., 2., -2., 1., -2., 0., 1., 0., : 2., 0., -2., 0., 1., 1., 0., 0., 0., : 0., 0., 2., -2., 2., -13187., -16., 5736., -31., : 0., 1., 0., 0., 0., 1426., -34., 54., -1. / DATA ((X(I,J),I=1,9),J=11,20) / : 0., 1., 2., -2., 2., -517., 12., 224., -6., : 0., -1., 2., -2., 2., 217., -5., -95., 3., : 0., 0., 2., -2., 1., 129., 1., -70., 0., : 2., 0., 0., -2., 0., 48., 0., 1., 0., : 0., 0., 2., -2., 0., -22., 0., 0., 0., : 0., 2., 0., 0., 0., 17., -1., 0., 0., : 0., 1., 0., 0., 1., -15., 0., 9., 0., : 0., 2., 2., -2., 2., -16., 1., 7., 0., : 0., -1., 0., 0., 1., -12., 0., 6., 0., : -2., 0., 0., 2., 1., -6., 0., 3., 0. / DATA ((X(I,J),I=1,9),J=21,30) / : 0., -1., 2., -2., 1., -5., 0., 3., 0., : 2., 0., 0., -2., 1., 4., 0., -2., 0., : 0., 1., 2., -2., 1., 4., 0., -2., 0., : 1., 0., 0., -1., 0., -4., 0., 0., 0., : 2., 1., 0., -2., 0., 1., 0., 0., 0., : 0., 0., -2., 2., 1., 1., 0., 0., 0., : 0., 1., -2., 2., 0., -1., 0., 0., 0., : 0., 1., 0., 0., 2., 1., 0., 0., 0., : -1., 0., 0., 1., 1., 1., 0., 0., 0., : 0., 1., 2., -2., 0., -1., 0., 0., 0. / DATA ((X(I,J),I=1,9),J=31,40) / : 0., 0., 2., 0., 2., -2274., -2., 977., -5., : 1., 0., 0., 0., 0., 712., 1., -7., 0., : 0., 0., 2., 0., 1., -386., -4., 200., 0., : 1., 0., 2., 0., 2., -301., 0., 129., -1., : 1., 0., 0., -2., 0., -158., 0., -1., 0., : -1., 0., 2., 0., 2., 123., 0., -53., 0., : 0., 0., 0., 2., 0., 63., 0., -2., 0., : 1., 0., 0., 0., 1., 63., 1., -33., 0., : -1., 0., 0., 0., 1., -58., -1., 32., 0., : -1., 0., 2., 2., 2., -59., 0., 26., 0./ DATA ((X(I,J),I=1,9),J=41,50) / : 1., 0., 2., 0., 1., -51., 0., 27., 0., : 0., 0., 2., 2., 2., -38., 0., 16., 0., : 2., 0., 0., 0., 0., 29., 0., -1., 0., : 1., 0., 2., -2., 2., 29., 0., -12., 0., : 2., 0., 2., 0., 2., -31., 0., 13., 0., : 0., 0., 2., 0., 0., 26., 0., -1., 0., : -1., 0., 2., 0., 1., 21., 0., -10., 0., : -1., 0., 0., 2., 1., 16., 0., -8., 0., : 1., 0., 0., -2., 1., -13., 0., 7., 0., : -1., 0., 2., 2., 1., -10., 0., 5., 0. / DATA ((X(I,J),I=1,9),J=51,60) / : 1., 1., 0., -2., 0., -7., 0., 0., 0., : 0., 1., 2., 0., 2., 7., 0., -3., 0., : 0., -1., 2., 0., 2., -7., 0., 3., 0., : 1., 0., 2., 2., 2., -8., 0., 3., 0., : 1., 0., 0., 2., 0., 6., 0., 0., 0., : 2., 0., 2., -2., 2., 6., 0., -3., 0., : 0., 0., 0., 2., 1., -6., 0., 3., 0., : 0., 0., 2., 2., 1., -7., 0., 3., 0., : 1., 0., 2., -2., 1., 6., 0., -3., 0., : 0., 0., 0., -2., 1., -5., 0., 3., 0. / DATA ((X(I,J),I=1,9),J=61,70) / : 1., -1., 0., 0., 0., 5., 0., 0., 0., : 2., 0., 2., 0., 1., -5., 0., 3., 0., : 0., 1., 0., -2., 0., -4., 0., 0., 0., : 1., 0., -2., 0., 0., 4., 0., 0., 0., : 0., 0., 0., 1., 0., -4., 0., 0., 0., : 1., 1., 0., 0., 0., -3., 0., 0., 0., : 1., 0., 2., 0., 0., 3., 0., 0., 0., : 1., -1., 2., 0., 2., -3., 0., 1., 0., : -1., -1., 2., 2., 2., -3., 0., 1., 0., : -2., 0., 0., 0., 1., -2., 0., 1., 0. / DATA ((X(I,J),I=1,9),J=71,80) / : 3., 0., 2., 0., 2., -3., 0., 1., 0., : 0., -1., 2., 2., 2., -3., 0., 1., 0., : 1., 1., 2., 0., 2., 2., 0., -1., 0., : -1., 0., 2., -2., 1., -2., 0., 1., 0., : 2., 0., 0., 0., 1., 2., 0., -1., 0., : 1., 0., 0., 0., 2., -2., 0., 1., 0., : 3., 0., 0., 0., 0., 2., 0., 0., 0., : 0., 0., 2., 1., 2., 2., 0., -1., 0., : -1., 0., 0., 0., 2., 1., 0., -1., 0., : 1., 0., 0., -4., 0., -1., 0., 0., 0. / DATA ((X(I,J),I=1,9),J=81,90) / : -2., 0., 2., 2., 2., 1., 0., -1., 0., : -1., 0., 2., 4., 2., -2., 0., 1., 0., : 2., 0., 0., -4., 0., -1., 0., 0., 0., : 1., 1., 2., -2., 2., 1., 0., -1., 0., : 1., 0., 2., 2., 1., -1., 0., 1., 0., : -2., 0., 2., 4., 2., -1., 0., 1., 0., : -1., 0., 4., 0., 2., 1., 0., 0., 0., : 1., -1., 0., -2., 0., 1., 0., 0., 0., : 2., 0., 2., -2., 1., 1., 0., -1., 0., : 2., 0., 2., 2., 2., -1., 0., 0., 0. / DATA ((X(I,J),I=1,9),J=91,100) / : 1., 0., 0., 2., 1., -1., 0., 0., 0., : 0., 0., 4., -2., 2., 1., 0., 0., 0., : 3., 0., 2., -2., 2., 1., 0., 0., 0., : 1., 0., 2., -2., 0., -1., 0., 0., 0., : 0., 1., 2., 0., 1., 1., 0., 0., 0., : -1., -1., 0., 2., 1., 1., 0., 0., 0., : 0., 0., -2., 0., 1., -1., 0., 0., 0., : 0., 0., 2., -1., 2., -1., 0., 0., 0., : 0., 1., 0., 2., 0., -1., 0., 0., 0., : 1., 0., -2., -2., 0., -1., 0., 0., 0. / DATA ((X(I,J),I=1,9),J=101,106) / : 0., -1., 2., 0., 1., -1., 0., 0., 0., : 1., 1., 0., -2., 1., -1., 0., 0., 0., : 1., 0., -2., 2., 0., -1., 0., 0., 0., : 2., 0., 0., 2., 0., 1., 0., 0., 0., : 0., 0., 2., 4., 2., -1., 0., 0., 0., : 0., 1., 0., 1., 0., 1., 0., 0., 0. / * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and given epoch (JC). T = ( ( EPOCH1-DJ0 ) + EPOCH2 ) / DJC * * FUNDAMENTAL ARGUMENTS in the FK5 reference system * * Mean longitude of the Moon minus mean longitude of the Moon's * perigee. EL = iau_ANPM ( ( 485866.733D0 + ( 715922.633D0 + : ( 31.310D0 + 0.064D0 * T ) * T ) * T ) * DAS2R : + MOD(1325D0*T, 1D0) * D2PI ) * Mean longitude of the Sun minus mean longitude of the Sun's perigee. ELP = iau_ANPM ( ( 1287099.804D0 + ( 1292581.224D0 + : ( -0.577D0 -0.012D0 * T ) * T ) * T ) * DAS2R : + MOD(99D0*T, 1D0) * D2PI ) * Mean longitude of the Moon minus mean longitude of the Moon's node. F = iau_ANPM ( ( 335778.877D0 + ( 295263.137D0 + : ( -13.257D0 + 0.011D0 * T ) * T ) * T ) * DAS2R : + MOD(1342D0*T, 1D0) * D2PI ) * Mean elongation of the Moon from the Sun. D = iau_ANPM ( ( 1072261.307D0 + ( 1105601.328D0 + : ( -6.891D0 + 0.019D0 * T ) * T ) * T ) * DAS2R : + MOD(1236D0*T, 1D0) * D2PI ) * Longitude of the mean ascending node of the lunar orbit on the * ecliptic, measured from the mean equinox of date. OM = iau_ANPM( ( 450160.280D0 + ( -482890.539D0 + : ( 7.455D0 + 0.008D0 * T ) * T ) * T ) * DAS2R : + MOD( -5D0*T, 1D0) * D2PI ) * --------------- * Nutation series * --------------- * Change time argument from centuries to millennia. T = T / 10D0 * Initialize nutation components. DP = 0D0 DE = 0D0 * Sum the nutation terms, ending with the biggest. DO 1 J=106,1,-1 * Form argument for current term. ARG = DBLE(X(1,J)) * EL : + DBLE(X(2,J)) * ELP : + DBLE(X(3,J)) * F : + DBLE(X(4,J)) * D : + DBLE(X(5,J)) * OM * Accumulate current nutation term. S = DBLE(X(6,J)) + DBLE(X(7,J)) * T C = DBLE(X(8,J)) + DBLE(X(9,J)) * T IF ( S .NE. 0D0 ) DP = DP + S * SIN(ARG) IF ( C .NE. 0D0 ) DE = DE + c * COS(ARG) * Next term. 1 CONTINUE * Convert results from 0.1 mas units to radians. DPSI = DP * U2R DEPS = DE * U2R * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PMAT76 ( EPOCH1, EPOCH2, RMATP ) *+ * - - - - - - - - - - - * i a u _ P M A T 7 6 * - - - - - - - - - - - * * Precession matrix from J2000 to a specified date, IAU 1976 model. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * EPOCH1,EPOCH2 d ending epoch, TDB (Note 1) * * Returned: * RMATP d(3,3) precession matrix, J2000 -> EPOCH1+EPOCH2 * * Notes: * * 1) The ending epoch EPOCH1+EPOCH2 is a Julian Date, apportioned * in any convenient way between the arguments EPOCH1 and EPOCH2. * For example, JD(TDB)=2450123.7 could be expressed in any of * these ways, among others: * * EPOCH1 EPOCH2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The matrix operates in the sense V(date) = RMATP * V(J2000), * where the p-vector V(J2000) is with respect to the mean * equatorial triad of epoch J2000 and the p-vector V(date) * is with respect to the mean equatorial triad of the given * epoch. * * 3) Though the matrix method itself is rigorous, the precession * angles are expressed through canonical polynomials which are * valid only for a limited time span. In addition, the IAU 1976 * precession rate is known to be imperfect. The absolute accuracy * of the present formulation is better than 0.1 arcsec from * 1960AD to 2040AD, better than 1 arcsec from 1640AD to 2360AD, * and remains below 3 arcsec for the whole of the period * 500BC to 3000AD. The errors exceed 10 arcsec outside the * range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to * 5600AD and exceed 1000 arcsec outside 6800BC to 8200AD. * * Called: * iau_PREC76 accumulated precession angles, IAU 1976 * iau_IR initialize r-matrix to identity * iau_RZ rotate around Z-axis * iau_RY rotate around Y-axis * iau_CR copy r-matrix * * References: * * Lieske,J.H., 1979. Astron.Astrophys.,73,282. * equations (6) & (7), p283. * * Kaplan,G.H., 1981. USNO circular no. 163, pA2. * * This revision: 2003 January 14 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION EPOCH1, EPOCH2, RMATP(3,3) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) DOUBLE PRECISION ZETA, Z, THETA, WMAT(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Precession Euler angles, J2000 to specified epoch. CALL iau_PREC76 ( DJ0, 0D0, EPOCH1, EPOCH2, ZETA, Z, THETA ) * Form the rotation matrix. CALL iau_IR ( WMAT ) CALL iau_RZ ( -ZETA, WMAT ) CALL iau_RY ( THETA, WMAT ) CALL iau_RZ ( -Z, WMAT ) CALL iau_CR ( WMAT, RMATP ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END DOUBLE PRECISION FUNCTION iau_OBL80 ( EPOCH1, EPOCH2 ) *+ * - - - - - - - - - - * i a u _ O B L 8 0 * - - - - - - - - - - * * Mean obliquity of the ecliptic, IAU 1980 model. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * EPOCH1,EPOCH2 d TDB starting epoch (Note 1) * * Returned: * iau_OBL80 d obliquity of the ecliptic (radians, Note 2) * * Notes: * * 1) The epoch EPOCH1+EPOCH2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TDB)=2450123.7 could be expressed in any of these ways, * among others: * * EPOCH1 EPOCH2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The result is the angle between the ecliptic of J2000 and the mean * equator of date EPOCH1+EPOCH2. * * Reference: * * Explanatory Supplement to the Astronomical Almanac, * P. Kenneth Seidelmann (ed), University Science Books (1992), * Expression 3.222-1 (p114). * * This revision: 2001 September 16 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION EPOCH1, EPOCH2 * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) DOUBLE PRECISION T * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and given epoch (JC). T = ( ( EPOCH1-DJ0 ) + EPOCH2 ) / DJC * Mean obliquity of date. iau_OBL80 = DAS2R * ( 84381.448D0 + : ( -46.8150D0 + : ( -0.00059D0 + : 0.001813D0 * T ) * T ) * T ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_C2IBPN ( DATE1, DATE2, RBPN, RC2I ) *+ * - - - - - - - - - - - * i a u _ C 2 I B P N * - - - - - - - - - - - * * Form the celestial-to-intermediate matrix for a given date given * the bias-precession-nutation matrix. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * RBPN d(3,3) celestial-to-true matrix (Note 2) * * Returned: * RC2I d(3,3) celestial-to-intermediate matrix (Note 3) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The matrix RBPN transforms vectors from GCRS to true of date * (CIP/equinox). * * 3) The matrix RC2I is the first stage in the transformation from * celestial to terrestrial coordinates: * * [TRS] = RPOM * R_3(ERA) * RC2I * [CRS] * * = RC2T * [CRS] * * where [CRS] is a vector in the Geocentric Celestial Reference * System and [TRS] is a vector in the International Terrestrial * Reference System (see IERS Conventions 2000), ERA is the Earth * Rotation Angle and RPOM is the polar motion matrix. * * Called: * iau_BPN2XY extract CIP coordinates from b-p-n matrix * iau_C2IXY celestial-to-intermediate matrix given X,Y * * Reference: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * This revision: 2002 December 23 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, RBPN(3,3), RC2I(3,3) DOUBLE PRECISION X, Y * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Extract the X,Y coordinates. CALL iau_BPN2XY ( RBPN, X, Y ) * Form the celestial-to-intermediate matrix. CALL iau_C2IXY ( DATE1, DATE2, X, Y, RC2I ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PNM00A ( DATE1, DATE2, RBPN ) *+ * - - - - - - - - - - - * i a u _ P N M 0 0 A * - - - - - - - - - - - * * Form the matrix of precession-nutation for a given date (including * frame bias), IAU 2000A model. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * RBPN d(3,3) bias+precession+nutation matrix (Note 2) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The matrix operates in the sense V(date) = RBPN * V(GCRS), where * the p-vector V(date) is with respect to the true equatorial triad * of date DATE1+DATE2 and the p-vector V(J2000) is with respect to * the mean equatorial triad of the Geocentric Celestial Reference * System (IAU, 2000). * * 3) A faster, but slightly less accurate result (about 1 mas), can be * obtained by using instead the iau_PNM00B routine. * * Called: * iau_PN00A bias/precession/nutation, IAU 2000A * * Reference: * * IAU: Trans. International Astronomical Union, Vol. XXIVB; Proc. * 24th General Assembly, Manchester, UK. Resolutions B1.3, B1.6. * (2000) * * This revision: 2003 February 27 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, RBPN(3,3) DOUBLE PRECISION DPSI, DEPS, EPSA, RB(3,3), RP(3,3), RBP(3,3), : RN(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Obtain the required matrix (discarding other results). CALL iau_PN00A ( DATE1, DATE2, : DPSI, DEPS, EPSA, RB, RP, RBP, RN, RBPN ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_CR ( R, C ) *+ * - - - - - - - * i a u _ C R * - - - - - - - * * Copy an r-matrix. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * R d(3,3) r-matrix to be copied * * Returned: * C d(3,3) copy * * Called: * iau_CP copy p-vector * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION R(3,3), C(3,3) INTEGER I * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO 1 I=1,3 CALL iau_CP ( R(1,I), C(1,I) ) 1 CONTINUE * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_RZ ( PSI, R ) *+ * - - - - - - - * i a u _ R Z * - - - - - - - * * Rotate an r-matrix about the z-axis. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * PSI d angle (radians) * * Given and returned: * R d(3,3) r-matrix, rotated * * Sign convention: The matrix can be used to rotate the * reference frame of a vector. Calling this routine with * positive PSI incorporates in the matrix an additional * rotation, about the z-axis, anticlockwise as seen looking * towards the origin from positive z. * * Called: * iau_IR initialize r-matrix to identity * iau_RXR r-matrix multiply * iau_CR r-matrix copy * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION PSI, R(3,3) DOUBLE PRECISION S, C, A(3,3), W(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Matrix representing new rotation. S = SIN(PSI) C = COS(PSI) CALL iau_IR ( A ) A(1,1) = C A(2,1) = -S A(1,2) = S A(2,2) = C * Rotate. CALL iau_RXR ( A, R, W ) * Return result. CALL iau_CR ( W, R ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_RX ( PHI, R ) *+ * - - - - - - - * i a u _ R X * - - - - - - - * * Rotate an r-matrix about the x-axis. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * PHI d angle (radians) * * Given and returned: * R d(3,3) r-matrix * * Sign convention: The matrix can be used to rotate the * reference frame of a vector. Calling this routine with * positive PHI incorporates in the matrix an additional * rotation, about the x-axis, anticlockwise as seen looking * towards the origin from positive x. * * Called: * iau_IR initialize r-matrix to identity * iau_RXR r-matrix multiply * iau_CR r-matrix copy * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION PHI, R(3,3) DOUBLE PRECISION S, C, A(3,3), W(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Matrix representing new rotation. S = SIN(PHI) C = COS(PHI) CALL iau_IR ( A ) A(2,2) = C A(3,2) = -S A(2,3) = S A(3,3) = C * Rotate. CALL iau_RXR ( A, R, W ) * Return result. CALL iau_CR ( W, R ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_IR ( R ) *+ * - - - - - - - * i a u _ I R * - - - - - - - * * Initialize an r-matrix to the identity matrix. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Returned: * R d(3,3) r-matrix * * Called: * iau_ZR zero r-matrix * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION R(3,3) INTEGER I * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL iau_ZR ( R ) DO 1 I=1,3 R(I,I) = 1D0 1 CONTINUE * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END DOUBLE PRECISION FUNCTION iau_ANPM ( A ) *+ * - - - - - - - - - * i a u _ A N P M * - - - - - - - - - * * Normalize angle into the range -pi <= A < +pi. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * A d angle (radians) * * Returned: * iau_ANPM d angle in range +/-pi * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION A * Pi DOUBLE PRECISION DPI PARAMETER ( DPI = 3.141592653589793238462643D0 ) * 2Pi DOUBLE PRECISION D2PI PARAMETER ( D2PI = 6.283185307179586476925287D0 ) DOUBLE PRECISION W * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - W = MOD(A,D2PI) IF ( ABS(W) .GE. DPI ) W = W - SIGN(D2PI,A) iau_ANPM = W * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_RY ( THETA, R ) *+ * - - - - - - - * i a u _ R Y * - - - - - - - * * Rotate an r-matrix about the y-axis. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * THETA d angle (radians) * * Given and returned: * R d(3,3) r-matrix * * Sign convention: The matrix can be used to rotate the * reference frame of a vector. Calling this routine with * positive THETA incorporates in the matrix an additional * rotation, about the y-axis, anticlockwise as seen looking * towards the origin from positive y. * * Called: * iau_IR initialize r-matrix to identity * iau_RXR r-matrix multiply * iau_CR r-matrix copy * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION THETA, R(3,3) DOUBLE PRECISION S, C, A(3,3), W(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Matrix representing new rotation. S = SIN(THETA) C = COS(THETA) CALL iau_IR ( A ) A(1,1) = C A(3,1) = S A(1,3) = -S A(3,3) = C * Rotate. CALL iau_RXR ( A, R, W ) * Return result. CALL iau_CR ( W, R ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PREC76 ( EP01, EP02, EP11, EP12, ZETA, Z, THETA ) *+ * - - - - - - - - - - - * i a u _ P R E C 7 6 * - - - - - - - - - - - * * IAU 1976 precession model. * * This routine forms the three Euler angles which implement general * precession between two epochs, using the IAU 1976 model (as for * the FK5 catalog). * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * EP01,EP02 d TDB starting epoch (Note 1) * EP11,EP12 d TDB ending epoch (Note 1) * * Returned: * ZETA d 1st rotation: radians clockwise around z * Z d 3rd rotation: radians clockwise around z * THETA d 2nd rotation: radians counterclockwise around y * * Notes: * * 1) The epochs EP01+EP02 and EP11+EP12 are Julian Dates, apportioned * in any convenient way between the arguments EPn1 and EPn2. For * example, JD(TDB)=2450123.7 could be expressed in any of these * ways, among others: * * EPn1 EPn2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in cases * where the loss of several decimal digits of resolution is * acceptable. The J2000 method is best matched to the way the * argument is handled internally and will deliver the optimum * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * The two epochs may be expressed using different methods, but at * the risk of losing some resolution. * * 2) The accumulated precession angles zeta, z, theta are expressed * through canonical polynomials which are valid only for a limited * time span. In addition, the IAU 1976 precession rate is known to * be imperfect. The absolute accuracy of the present formulation is * better than 0.1 arcsec from 1960AD to 2040AD, better than 1 arcsec * from 1640AD to 2360AD, and remains below 3 arcsec for the whole of * the period 500BC to 3000AD. The errors exceed 10 arcsec outside * the range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to * 5600AD and exceed 1000 arcsec 1000 arcsec outside 6800BC to * 8200AD. * * 3) The three angles are returned in the conventional order, which * is not the same as the order of the corresponding Euler rotations. * The precession matrix is R_3(-z) x R_2(+theta) x R_3(-zeta). * * Reference: * * Lieske,J.H., 1979. Astron.Astrophys.,73,282. * equations (6) & (7), p283. * * This revision: 2003 January 14 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION EP01, EP02, EP11, EP12, ZETA, Z, THETA * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) DOUBLE PRECISION T0, T, TAS2R, W * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and beginning epoch (JC). T0 = ( ( EP01-DJ0 ) + EP02 ) / DJC * Interval over which precession required (JC). T = ( ( EP11-EP01 ) + ( EP12-EP02 ) ) / DJC * Euler angles. TAS2R = T * DAS2R W = 2306.2181D0 + ( : 1.39656D0 : - 0.000139D0 * T0 ) * T0 ZETA = ( W + ( ( 0.30188D0 : - 0.000344D0 * T0 ) : + 0.017998D0 * T ) * T ) * TAS2R Z = ( W + ( ( 1.09468D0 : + 0.000066D0 * T0 ) : + 0.018203D0 * T ) * T ) * TAS2R THETA = ( ( 2004.3109D0 + ( : - 0.85330D0 : - 0.000217D0 * T0 ) * T0 ) + ( ( : - 0.42665D0 : - 0.000217D0 * T0 ) : - 0.041833D0 * T ) * T ) * TAS2R * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_C2IXY ( DATE1, DATE2, X, Y, RC2I ) *+ * - - - - - - - - - - * i a u _ C 2 I X Y * - - - - - - - - - - * * Form the celestial to intermediate-frame-of-date matrix for a given * date when the CIP X,Y coordinates are known. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * X,Y d Celestial Intermediate Pole (Note 2) * * Returned: * RC2I d(3,3) celestial-to-intermediate matrix (Note 3) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The Celestial Intermediate Pole coordinates are the x,y components * of the unit vector in the Geocentric Celestial Reference System. * * 3) The matrix RC2I is the first stage in the transformation from * celestial to terrestrial coordinates: * * [TRS] = RPOM * R_3(ERA) * RC2I * [CRS] * * = RC2T * [CRS] * * where [CRS] is a vector in the Geocentric Celestial Reference * System and [TRS] is a vector in the International Terrestrial * Reference System (see IERS Conventions 2000), ERA is the Earth * Rotation Angle and RPOM is the polar motion matrix. * * Called: * iau_C2IXYS celestial-to-intermediate matrix from X,Y,s * iau_S00 the quantity s, given X,Y * * Reference: * * McCarthy, D.D., IERS Conventions 2000, Chapter 5 (2002). * * This revision: 2002 November 11 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, X, Y, RC2I(3,3) DOUBLE PRECISION iau_S00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Compute s and then the matrix. CALL iau_C2IXYS ( X, Y, iau_S00 ( DATE1, DATE2, X, Y ), RC2I ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PN00A ( DATE1, DATE2, : DPSI, DEPS, EPSA, RB, RP, RBP, RN, RBPN ) *+ * - - - - - - - - - - * i a u _ P N 0 0 A * - - - - - - - - - - * * Precession-nutation, IAU 2000A model; a multi-purpose routine, * supporting both classical equinox-based use (directly) and CEO-based * use (indirectly). * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * DPSI,DEPS d nutation (Note 2) * EPSA d mean obliquity (Note 3) * RB d(3,3) frame bias matrix (Note 4) * RP d(3,3) precession matrix (Note 5) * RBP d(3,3) bias-precession matrix (Note 6) * RN d(3,3) nutation matrix (Note 7) * RBPN d(3,3) GCRS-to-true matrix (Notes 8,9) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The nutation components (luni-solar + planetary, IAU 2000A) in * longitude and obliquity are in radians and with respect to the * equinox and ecliptic of date. Free core nutation is omitted; for * the utmost accuracy, use the iau_PN00 routine, where the nutation * components are caller-specified. For faster but slightly less * accurate results, use the iau_PN00B routine. * * 3) The mean obliquity is consistent with the IAU 2000 precession- * nutation models. * * 4) The matrix RB transforms vectors from GCRS to mean J2000 by * applying frame bias. * * 5) The matrix RP transforms vectors from mean J2000 to mean of date * by applying precession. * * 6) The matrix RBP transforms vectors from GCRS to mean of date by * applying frame bias then precession. It is the product RP x RB. * * 7) The matrix RN transforms vectors from mean of date to true of date * by applying the nutation (luni-solar + planetary). * * 8) The matrix RBPN transforms vectors from GCRS to true of date * (CIP/equinox). It is the product RN x RBP, applying frame bias, * precession and nutation in that order. * * 9) The X,Y,Z coordinates of the IAU 2000A Celestial Intermediate Pole * are elements (3,1-3) of the matrix RBPN. * * Called: * iau_NUT00A nutation, IAU 2000A * iau_PN00 bias/precession/nutation results * * Reference: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * This revision: 2002 December 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, DPSI, DEPS, EPSA, : RB(3,3), RP(3,3), RBP(3,3), RN(3,3), RBPN(3,3) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Nutation. CALL iau_NUT00A ( DATE1, DATE2, DPSI, DEPS ) * Remaining results. CALL iau_PN00 ( DATE1, DATE2, DPSI, DEPS, : EPSA, RB, RP, RBP, RN, RBPN ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_CP ( P, C ) *+ * - - - - - - - * i a u _ C P * - - - - - - - * * Copy a p-vector. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Given: * P d(3) p-vector to be copied * * Returned: * C d(3) copy * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION P(3), C(3) INTEGER I * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO 1 I=1,3 C(I) = P(I) 1 CONTINUE * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_ZR ( R ) *+ * - - - - - - - * i a u _ Z R * - - - - - - - * * Initialize an r-matrix to the null matrix. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: vector/matrix support routine. * * Returned: * R d(3,3) r-matrix * * This revision: 2000 November 25 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION R(3,3) INTEGER I, J * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO 2 J=1,3 DO 1 I=1,3 R(I,J) = 0D0 1 CONTINUE 2 CONTINUE * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_C2IXYS ( X, Y, S, RC2I ) *+ * - - - - - - - - - - - * i a u _ C 2 I X Y S * - - - - - - - - - - - * * Form the celestial to intermediate-frame-of-date matrix given the CIP * X,Y and the quantity s. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * X,Y d Celestial Intermediate Pole (Note 1) * S d the quantity s (Note 2) * * Returned: * RC2I d(3,3) celestial-to-intermediate matrix (Note 3) * * Notes: * * 1) The Celestial Intermediate Pole coordinates are the x,y components * of the unit vector in the Geocentric Celestial Reference System. * * 2) The quantity s (in radians) positions the Celestial Ephemeris * Origin on the equator of the CIP. * * 3) The matrix RC2I is the first stage in the transformation from * celestial to terrestrial coordinates: * * [TRS] = RPOM * R_3(ERA) * RC2I * [CRS] * * = RC2T * [CRS] * * where [CRS] is a vector in the Geocentric Celestial Reference * System and [TRS] is a vector in the International Terrestrial * Reference System (see IERS Conventions 2000), ERA is the Earth * Rotation Angle and RPOM is the polar motion matrix. * * Called: * iau_IR initialize r-matrix to identity * iau_RZ rotate around Z-axis * iau_RY rotate around Y-axis * * Reference: * * McCarthy, D.D., IERS Conventions 2000, Chapter 5 (2002). * * This revision: 2002 November 9 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION X, Y, S, RC2I(3,3) DOUBLE PRECISION E, D * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Obtain the spherical angles E and d. IF ( X.NE.0D0 .OR. Y.NE.0D0 ) THEN E = ATAN2 ( Y, X ) ELSE E = 0D0 END IF D = ATAN ( SQRT((X*X+Y*Y) / (1D0-(X*X+Y*Y))) ) * Form the matrix. CALL iau_IR ( RC2I ) CALL iau_RZ ( E, RC2I ) CALL iau_RY ( D, RC2I ) CALL iau_RZ ( -(E+S), RC2I ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END DOUBLE PRECISION FUNCTION iau_S00 ( DATE1, DATE2, X, Y ) *+ * - - - - - - - - * i a u _ S 0 0 * - - - - - - - - * * The quantity s, positioning the Celestial Ephemeris Origin on the * equator of the Celestial Intermediate Pole, given the CIP's X,Y * coordinates. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * X,Y d CIP coordinates (Note 3) * * Returned: * iau_S00 d the quantity s in radians (Note 2) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The quantity s is the difference between the right ascensions * of the same point in two frames. The two systems are the GCRS * and the CIP,CEO, and the point is the ascending node of the * respective equators. The quantity s remains a small fraction of * 1 arcsecond throughout 1900-2100. * * 3) The series used to compute s is in fact for s+XY/2, where X and Y * are the x and y components of the CIP unit vector; this series is * more compact than a direct series for s would be. This routine * requires X,Y to be supplied by the caller, who is responsible for * providing values that are consistent with the supplied date. * * Called: * iau_ANPM normalize angle into range +/- pi * * References: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * McCarthy, D.D., IERS Conventions 2000, Chapter 5 (2002). * * This revision: 2003 January 14 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, X, Y * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * 2Pi DOUBLE PRECISION D2PI PARAMETER ( D2PI = 6.283185307179586476925287D0 ) * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) * Time since J2000, in Julian centuries DOUBLE PRECISION T * Miscellaneous INTEGER I, J DOUBLE PRECISION A, S0, S1, S2, S3, S4, S5 DOUBLE PRECISION iau_ANPM * Fundamental arguments DOUBLE PRECISION FA(14) * --------------------- * The series for s+XY/2 * --------------------- * Number of terms in the series INTEGER NSP, NS0, NS1, NS2, NS3, NS4 PARAMETER ( NSP=6, NS0= 33, NS1= 3, NS2=25, NS3=4, NS4=1 ) * Polynomial coefficients DOUBLE PRECISION SP ( NSP ) * Coefficients of l,l',F,D,Om,LMe,LVe,LE,LMa,LJu,LSa,LU,LN,pA INTEGER KS0 ( 14, NS0 ), : KS1 ( 14, NS1 ), : KS2 ( 14, NS2 ), : KS3 ( 14, NS3 ), : KS4 ( 14, NS4 ) * Sine and cosine coefficients DOUBLE PRECISION SS0 ( 2, NS0 ), : SS1 ( 2, NS1 ), : SS2 ( 2, NS2 ), : SS3 ( 2, NS3 ), : SS4 ( 2, NS4 ) * Polynomial coefficients DATA SP / 94 D-6, : 3808.35 D-6, : -119.94 D-6, : -72574.09 D-6, : 27.70 D-6, : 15.61 D-6 / * Argument coefficients for t^0 DATA ( ( KS0(I,J), I=1,14), J = 1, 10 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA ( ( KS0(I,J), I=1,14), J = 11, 20 ) / : 1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 2, -2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 2, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 4, -4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, -8, 12, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA ( ( KS0(I,J), I=1,14), J = 21, 30 ) / : 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, -2, 2, -3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, -2, 2, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 8,-13, 0, 0, 0, 0, 0, -1, : 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 2, 0, -2, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, -2, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 4, -2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA ( ( KS0(I,J), I=1,14), J = 31, NS0 ) / : 0, 0, 2, -2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, -2, 0, -3, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, -2, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0 / * Argument coefficients for t^1 DATA ( ( KS1(I,J), I=1,14), J = 1, NS1 ) / : 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0 / * Argument coefficients for t^2 DATA ( ( KS2(I,J), I=1,14), J = 1, 10 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 1, -2, 2, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA ( ( KS2(I,J), I=1,14), J = 11, 20 ) / : 1, 0, 0, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, -2, 0, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, -2, -2, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 2, 0, 0, -2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 2, 0, -2, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA ( ( KS2(I,J), I=1,14), J = 21, NS2 ) / : 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 2, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 1, 0, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 / * Argument coefficients for t^3 DATA ( ( KS3(I,J), I=1,14), J = 1, NS3 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0 / * Argument coefficients for t^4 DATA ( ( KS4(I,J), I=1,14), J = 1, NS4 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 / * Sine and cosine coefficients for t^0 DATA ( ( SS0(I,J), I=1,2), J = 1, 10 ) / : -2640.73D-6, +0.39D-6, : -63.53D-6, +0.02D-6, : -11.75D-6, -0.01D-6, : -11.21D-6, -0.01D-6, : +4.57D-6, +0.00D-6, : -2.02D-6, +0.00D-6, : -1.98D-6, +0.00D-6, : +1.72D-6, +0.00D-6, : +1.41D-6, +0.01D-6, : +1.26D-6, +0.01D-6 / DATA ( ( SS0(I,J), I=1,2), J = 11, 20 ) / : +0.63D-6, +0.00D-6, : +0.63D-6, +0.00D-6, : -0.46D-6, +0.00D-6, : -0.45D-6, +0.00D-6, : -0.36D-6, +0.00D-6, : +0.24D-6, +0.12D-6, : -0.32D-6, +0.00D-6, : -0.28D-6, +0.00D-6, : -0.27D-6, +0.00D-6, : -0.26D-6, +0.00D-6 / DATA ( ( SS0(I,J), I=1,2), J = 21, 30 ) / : +0.21D-6, +0.00D-6, : -0.19D-6, +0.00D-6, : -0.18D-6, +0.00D-6, : +0.10D-6, -0.05D-6, : -0.15D-6, +0.00D-6, : +0.14D-6, +0.00D-6, : +0.14D-6, +0.00D-6, : -0.14D-6, +0.00D-6, : -0.14D-6, +0.00D-6, : -0.13D-6, +0.00D-6 / DATA ( ( SS0(I,J), I=1,2), J = 31, NS0 ) / : +0.11D-6, +0.00D-6, : -0.11D-6, +0.00D-6, : -0.11D-6, +0.00D-6 / * Sine and cosine coefficients for t^1 DATA ( ( SS1(I,J), I=1,2), J = 1, NS1 ) / : -0.07D-6, +3.57D-6, : +1.71D-6, -0.03D-6, : +0.00D-6, +0.48D-6 / * Sine and cosine coefficients for t^2 DATA ( ( SS2(I,J), I=1,2), J = 1, 10 ) / : +743.53D-6, -0.17D-6, : +56.91D-6, +0.06D-6, : +9.84D-6, -0.01D-6, : -8.85D-6, +0.01D-6, : -6.38D-6, -0.05D-6, : -3.07D-6, +0.00D-6, : +2.23D-6, +0.00D-6, : +1.67D-6, +0.00D-6, : +1.30D-6, +0.00D-6, : +0.93D-6, +0.00D-6 / DATA ( ( SS2(I,J), I=1,2), J = 11, 20 ) / : +0.68D-6, +0.00D-6, : -0.55D-6, +0.00D-6, : +0.53D-6, +0.00D-6, : -0.27D-6, +0.00D-6, : -0.27D-6, +0.00D-6, : -0.26D-6, +0.00D-6, : -0.25D-6, +0.00D-6, : +0.22D-6, +0.00D-6, : -0.21D-6, +0.00D-6, : +0.20D-6, +0.00D-6 / DATA ( ( SS2(I,J), I=1,2), J = 21, NS2 ) / : +0.17D-6, +0.00D-6, : +0.13D-6, +0.00D-6, : -0.13D-6, +0.00D-6, : -0.12D-6, +0.00D-6, : -0.11D-6, +0.00D-6 / * Sine and cosine coefficients for t^3 DATA ( ( SS3(I,J), I=1,2), J = 1, NS3 ) / : +0.30D-6, -23.51D-6, : -0.03D-6, -1.39D-6, : -0.01D-6, -0.24D-6, : +0.00D-6, +0.22D-6 / * Sine and cosine coefficients for t^4 DATA ( ( SS4(I,J), I=1,2), J = 1, NS4 ) / : -0.26D-6, -0.01D-6 / * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and current date (JC). T = ( ( DATE1-DJ0 ) + DATE2 ) / DJC * Fundamental Arguments (from IERS Conventions 2000) * Mean Anomaly of the Moon. FA(1) = iau_ANPM ( ( 485868.249036D0 + : ( 715923.2178D0 + : ( 31.8792D0 + : ( 0.051635D0 + : ( -0.00024470D0 ) : * T ) * T ) * T ) * T ) * DAS2R : + MOD ( 1325D0*T, 1D0 ) * D2PI ) * Mean Anomaly of the Sun. FA(2) = iau_ANPM ( ( 1287104.793048D0 + : ( 1292581.0481D0 + : ( -0.5532D0 + : ( +0.000136D0 + : ( -0.00001149D0 ) : * T ) * T ) * T ) * T ) * DAS2R : + MOD ( 99D0*T, 1D0 ) * D2PI ) * Mean Longitude of the Moon minus Mean Longitude of the Ascending * Node of the Moon. FA(3) = iau_ANPM ( ( 335779.526232D0 + : ( 295262.8478D0 + : ( -12.7512D0 + : ( -0.001037D0 + : ( 0.00000417D0 ) : * T ) * T ) * T ) * T ) * DAS2R : + MOD ( 1342D0*T, 1D0 ) * D2PI ) * Mean Elongation of the Moon from the Sun. FA(4) = iau_ANPM ( ( 1072260.703692D0 + : ( 1105601.2090D0 + : ( -6.3706D0 + : ( 0.006593D0 + : ( -0.00003169D0 ) : * T ) * T ) * T ) * T ) * DAS2R : + MOD ( 1236D0*T, 1D0 ) * D2PI ) * Mean Longitude of the Ascending Node of the Moon. FA(5) = iau_ANPM ( ( 450160.398036D0 + : ( -482890.5431D0 + : ( 7.4722D0 + : ( 0.007702D0 + : ( -0.00005939D0 ) : * T ) * T ) * T ) * T ) * DAS2R : + MOD ( -5D0*T, 1D0 ) * D2PI ) FA( 6) = iau_ANPM ( 4.402608842D0 + 2608.7903141574D0 * T ) FA( 7) = iau_ANPM ( 3.176146697D0 + 1021.3285546211D0 * T ) FA( 8) = iau_ANPM ( 1.753470314D0 + 628.3075849991D0 * T ) FA( 9) = iau_ANPM ( 6.203480913D0 + 334.0612426700D0 * T ) FA(10) = iau_ANPM ( 0.599546497D0 + 52.9690962641D0 * T ) FA(11) = iau_ANPM ( 0.874016757D0 + 21.3299104960D0 * T ) FA(12) = iau_ANPM ( 5.481293872D0 + 7.4781598567D0 * T ) FA(13) = iau_ANPM ( 5.311886287D0 + 3.8133035638D0 * T ) FA(14) = ( 0.024381750D0 + 0.00000538691D0 * T ) * T * Evaluate S. S0 = SP(1) S1 = SP(2) S2 = SP(3) S3 = SP(4) S4 = SP(5) S5 = SP(6) DO 2 I = NS0,1,-1 A = 0D0 DO 1 J=1,14 A = A + DBLE(KS0(J,I))*FA(J) 1 CONTINUE S0 = S0 + ( SS0(1,I)*SIN(A) + SS0(2,I)*COS(A) ) 2 CONTINUE DO 4 I = NS1,1,-1 A = 0D0 DO 3 J=1,14 A = A + DBLE(KS1(J,I))*FA(J) 3 CONTINUE S1 = S1 + ( SS1(1,I)*SIN(A) + SS1(2,I)*COS(A) ) 4 CONTINUE DO 6 I = NS2,1,-1 A = 0D0 DO 5 J=1,14 A = A + DBLE(KS2(J,I))*FA(J) 5 CONTINUE S2 = S2 + ( SS2(1,I)*SIN(A) + SS2(2,I)*COS(A) ) 6 CONTINUE DO 8 I = NS3,1,-1 A = 0D0 DO 7 J=1,14 A = A + DBLE(KS3(J,I))*FA(J) 7 CONTINUE S3 = S3 + ( SS3(1,I)*SIN(A) + SS3(2,I)*COS(A) ) 8 CONTINUE DO 10 I = NS4,1,-1 A = 0D0 DO 9 J=1,14 A = A + DBLE(KS4(J,I))*FA(J) 9 CONTINUE S4 = S4 + ( SS4(1,I)*SIN(A) + SS4(2,I)*COS(A) ) 10 CONTINUE iau_S00 = ( S0 + : ( S1 + : ( S2 + : ( S3 + : ( S4 + : S5 * T ) * T ) * T ) * T ) * T ) * DAS2R - X*Y/2D0 * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PN00 ( DATE1, DATE2, DPSI, DEPS, : EPSA, RB, RP, RBP, RN, RBPN ) *+ * - - - - - - - - - * i a u _ P N 0 0 * - - - - - - - - - * * Precession-nutation, IAU 2000 model; a multi-purpose routine, * supporting classical, equinox-based, use directly and CEO-based * use indirectly. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * DPSI,DEPS d nutation (Note 2) * * Returned: * EPSA d mean obliquity (Note 3) * RB d(3,3) frame bias matrix (Note 4) * RP d(3,3) precession matrix (Note 5) * RBP d(3,3) bias-precession matrix (Note 6) * RN d(3,3) nutation matrix (Note 7) * RBPN d(3,3) GCRS-to-true matrix (Note 8) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The caller is responsible for providing the nutation components; * they are in longitude and obliquity, in radians and are with * respect to the equinox and ecliptic of date. For high-accuracy * applications, free core nutation should be included as well as * any other relevant corrections to the position of the CIP. * * 3) The returned mean obliquity is consistent with the IAU 2000 * precession-nutation models. * * 4) The matrix RB transforms vectors from GCRS to mean J2000 by * applying frame bias. * * 5) The matrix RP transforms vectors from mean J2000 to mean of date * by applying precession. * * 6) The matrix RBP transforms vectors from GCRS to mean of date by * applying frame bias then precession. It is the product RP x RB. * * 7) The matrix RN transforms vectors from mean of date to true of date * by applying the nutation (luni-solar + planetary). * * 8) The matrix RBPN transforms vectors from GCRS to true of date * (CIP/equinox). It is the product RN x RBP, applying frame bias, * precession and nutation in that order. * * Called: * iau_PR00 IAU 2000 precession adjustments * iau_OBL80 mean obliquity, IAU 1980 * iau_BP00 frame bias and precession matrices * iau_NUMAT form nutation matrix * iau_RXR r-matrix product * * Reference: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * This revision: 2003 January 24 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, DPSI, DEPS, : EPSA, RB(3,3), RP(3,3), RBP(3,3), : RN(3,3), RBPN(3,3) DOUBLE PRECISION DPSIPR, DEPSPR DOUBLE PRECISION iau_OBL80 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * IAU 2000 precession-rate adjustments. CALL iau_PR00 ( DATE1, DATE2, DPSIPR, DEPSPR ) * Mean obliquity, consistent with IAU 2000 precession-nutation. EPSA = iau_OBL80 ( DATE1, DATE2 ) + DEPSPR * Frame bias and precession matrices and their product. CALL iau_BP00 ( DATE1, DATE2, RB, RP, RBP ) * Nutation matrix. CALL iau_NUMAT ( EPSA, DPSI, DEPS, RN ) * Bias-precession-nutation matrix (classical). CALL iau_RXR ( RN, RBP, RBPN ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_NUT00A ( DATE1, DATE2, DPSI, DEPS ) *+ * - - - - - - - - - - - * i a u _ N U T 0 0 A * - - - - - - - - - - - * * Nutation, IAU 2000A model (MHB_2000 luni-solar and planetary nutation * with free core nutation omitted). * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * DPSI,DEPS d nutation, luni-solar + planetary (Note 2) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The nutation components in longitude and obliquity are 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. * * Both the luni-solar and planetary nutations are included. The * latter are due to direct planetary nutations and the perturbations * of the lunar and terrestrial orbits. * * 3) The routine computes the MHB_2000 nutation series with the * associated corrections for planetary nutations. It is an * implementation of the nutation part of the IAU 2000A precession- * nutation model, formally adopted by the IAU General Assembly in * 2000, namely MHB2000 (Mathews et al. 2002), but with the free core * nutation (FCN - see Note 4) omitted. * * 4) The full MHB_2000 model also contains contributions to the * nutations in longitude and obliquity due to the free-excitation of * the free-core-nutation during the period 1979-2000. These FCN * terms, which are time-dependent and unpredictable, are NOT * included in the present routine and, if required, must be * independently computed. With the FCN corrections included, the * present routine delivers a pole which is at current epochs * accurate to a few hundred microarcseconds. The omission of FCN * introduces further errors of about that size. * * 5) The present routine provides classical nutation. The MHB_2000 * 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 algorithm also provides "total" nutations, comprising * the arithmetic sum of the frame bias, precession adjustments, * luni-solar nutation and planetary nutation. 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 sub-mas accuracy at current epochs. However, there * are three shortcomings in the MHB_2000 model that must be taken * into account if more accurate or definitive results are required * (see Wallace 2002) * * (i) The MHB_2000 total nutations are simply arithmetic sums, * yet in reality the various components are successive Euler * rotations. This slight lack of rigor leads to cross terms * that exceed 1 mas after a century. The rigorous procedure * is to form the GCRS-to-true rotation matrix by applying the * bias, precession and nutation in that order. * * (ii) Although the precession adjustments are stated to be with * respect to Lieske et al. (1977), the MHB_2000 model does * not specify which set of Euler angles are to be used and * how the adjustments are to be applied. The most literal and * straightforward procedure is to adopt the 4-rotation * epsilon_0, psi_A, omega_A, xi_A option, and to add DPSIPR to * psi_A and DEPSPR to both omega_A and eps_A. * * (iii) The MHB_2000 model predates the determination by Chapront * et al. (2002) of a 14.6 mas displacement between the J2000 * mean equinox and the origin of the ICRS frame. It should, * however, be noted that neglecting this displacement when * calculating star coordinates does not lead to a 14.6 mas * change in right ascension, only a small second-order * distortion in the pattern of the precession-nutation effect. * * For these reasons, the SOFA routines do not generate the "total * nutations" directly, though they can of course easily be generated * by calling iau_BI00, iau_PR00 and the present routine and adding * the results. * * References: * * Chapront, J., Chapront-Touze, M. & Francou, G., Astron.Astrophys., * 387, 700, 2002. * * 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-16, 1977. * * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation * and precession New nutation series for nonrigid Earth and * insights into the Earth's interior", J.Geophys.Res., 107, B4, * 2002. The MHB_2000 code itself was obtained on 9th September 2002 * from ftp //maia.usno.navy.mil/conv2000/chapter5/IAU2000A. * * Simon, J.-L., Bretagnon, P., Chapront, J., Chapront-Touze, M., * Francou, G., Laskar, J., A&A282, 663-683 (1994). * * Souchay, J., Loysel, B., Kinoshita, H., Folgueira, M., A&A Supp. * Ser. 135, 111 (1999) * * Wallace, P.T., "Software for Implementing the IAU 2000 * Resolutions", in IERS Workshop 5.1, 2002. * * This revision: 2002 December 23 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, DPSI, DEPS * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Arc seconds in a full circle DOUBLE PRECISION TURNAS PARAMETER ( TURNAS = 1296000D0 ) * 2Pi DOUBLE PRECISION D2PI PARAMETER ( D2PI = 6.283185307179586476925287D0 ) * Units of 0.1 microarcsecond to radians DOUBLE PRECISION U2R PARAMETER ( U2R = DAS2R/1D7 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) * Miscellaneous DOUBLE PRECISION T, EL, ELP, F, D, OM, ARG, DP, DE, SARG, CARG, : AL, ALSU, AF, AD, AOM, ALME, ALVE, ALEA, ALMA, : ALJU, ALSA, ALUR, ALNE, APA, DPSILS, DEPSLS, : DPSIPL, DEPSPL INTEGER I, J * ------------------------- * Luni-Solar nutation model * ------------------------- * Number of terms in the luni-solar nutation model INTEGER NLS PARAMETER ( NLS = 678 ) * Coefficients for fundamental arguments INTEGER NALS(5,NLS) * Longitude and obliquity coefficients DOUBLE PRECISION CLS(6,NLS) * --------------- * Planetary terms * --------------- * Number of terms in the planetary nutation model INTEGER NPL PARAMETER ( NPL = 687 ) * Coefficients for fundamental arguments INTEGER NAPL(14,NPL) * Longitude and obliquity coefficients INTEGER ICPL(4,NPL) * ---------------------------------------- * Tables of argument and term coefficients * ---------------------------------------- * * Luni-Solar argument multipliers * L L' F D Om DATA ( ( NALS(I,J), I=1,5 ), J= 1, 10 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 11, 20 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 21, 30 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 31, 40 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 41, 50 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 51, 60 ) / : 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 / DATA ( ( NALS(I,J), I=1,5 ), J= 61, 70 ) / : -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 / DATA ( ( NALS(I,J), I=1,5 ), J= 71, 80 ) / : -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, : -2, 0, 2, 4, 2, : -1, 0, 4, 0, 2, : 2, 0, 2, -2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J= 81, 90 ) / : 2, 0, 2, 2, 2, : 1, 0, 0, 2, 1, : 3, 0, 0, 0, 0, : 3, 0, 2, -2, 2, : 0, 0, 4, -2, 2, : 0, 1, 2, 0, 1, : 0, 0, -2, 2, 1, : 0, 0, 2, -2, 3, : -1, 0, 0, 4, 0, : 2, 0, -2, 0, 1 / DATA ( ( NALS(I,J), I=1,5 ), J= 91,100 ) / : -2, 0, 0, 4, 0, : -1, -1, 0, 2, 1, : -1, 0, 0, 1, 1, : 0, 1, 0, 0, 2, : 0, 0, -2, 0, 1, : 0, -1, 2, 0, 1, : 0, 0, 2, -1, 2, : 0, 0, 2, 4, 2, : -2, -1, 0, 2, 0, : 1, 1, 0, -2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=101,110 ) / : -1, 1, 0, 2, 0, : -1, 1, 0, 1, 2, : 1, -1, 0, 0, 1, : 1, -1, 2, 2, 2, : -1, 1, 2, 2, 2, : 3, 0, 2, 0, 1, : 0, 1, -2, 2, 0, : -1, 0, 0, -2, 1, : 0, 1, 2, 2, 2, : -1, -1, 2, 2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=111,120 ) / : 0, -1, 0, 0, 2, : 1, 0, 2, -4, 1, : -1, 0, -2, 2, 0, : 0, -1, 2, 2, 1, : 2, -1, 2, 0, 2, : 0, 0, 0, 2, 2, : 1, -1, 2, 0, 1, : -1, 1, 2, 0, 2, : 0, 1, 0, 2, 0, : 0, -1, -2, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=121,130 ) / : 0, 3, 2, -2, 2, : 0, 0, 0, 1, 1, : -1, 0, 2, 2, 0, : 2, 1, 2, 0, 2, : 1, 1, 0, 0, 1, : 1, 1, 2, 0, 1, : 2, 0, 0, 2, 0, : 1, 0, -2, 2, 0, : -1, 0, 0, 2, 2, : 0, 1, 0, 1, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=131,140 ) / : 0, 1, 0, -2, 1, : -1, 0, 2, -2, 2, : 0, 0, 0, -1, 1, : -1, 1, 0, 0, 1, : 1, 0, 2, -1, 2, : 1, -1, 0, 2, 0, : 0, 0, 0, 4, 0, : 1, 0, 2, 1, 2, : 0, 0, 2, 1, 1, : 1, 0, 0, -2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=141,150 ) / : -1, 0, 2, 4, 1, : 1, 0, -2, 0, 1, : 1, 1, 2, -2, 1, : 0, 0, 2, 2, 0, : -1, 0, 2, -1, 1, : -2, 0, 2, 2, 1, : 4, 0, 2, 0, 2, : 2, -1, 0, 0, 0, : 2, 1, 2, -2, 2, : 0, 1, 2, 1, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=151,160 ) / : 1, 0, 4, -2, 2, : -1, -1, 0, 0, 1, : 0, 1, 0, 2, 1, : -2, 0, 2, 4, 1, : 2, 0, 2, 0, 0, : 1, 0, 0, 1, 0, : -1, 0, 0, 4, 1, : -1, 0, 4, 0, 1, : 2, 0, 2, 2, 1, : 0, 0, 2, -3, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=161,170 ) / : -1, -2, 0, 2, 0, : 2, 1, 0, 0, 0, : 0, 0, 4, 0, 2, : 0, 0, 0, 0, 3, : 0, 3, 0, 0, 0, : 0, 0, 2, -4, 1, : 0, -1, 0, 2, 1, : 0, 0, 0, 4, 1, : -1, -1, 2, 4, 2, : 1, 0, 2, 4, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=171,180 ) / : -2, 2, 0, 2, 0, : -2, -1, 2, 0, 1, : -2, 0, 0, 2, 2, : -1, -1, 2, 0, 2, : 0, 0, 4, -2, 1, : 3, 0, 2, -2, 1, : -2, -1, 0, 2, 1, : 1, 0, 0, -1, 1, : 0, -2, 0, 2, 0, : -2, 0, 0, 4, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=181,190 ) / : -3, 0, 0, 0, 1, : 1, 1, 2, 2, 2, : 0, 0, 2, 4, 1, : 3, 0, 2, 2, 2, : -1, 1, 2, -2, 1, : 2, 0, 0, -4, 1, : 0, 0, 0, -2, 2, : 2, 0, 2, -4, 1, : -1, 1, 0, 2, 1, : 0, 0, 2, -1, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=191,200 ) / : 0, -2, 2, 2, 2, : 2, 0, 0, 2, 1, : 4, 0, 2, -2, 2, : 2, 0, 0, -2, 2, : 0, 2, 0, 0, 1, : 1, 0, 0, -4, 1, : 0, 2, 2, -2, 1, : -3, 0, 0, 4, 0, : -1, 1, 2, 0, 1, : -1, -1, 0, 4, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=201,210 ) / : -1, -2, 2, 2, 2, : -2, -1, 2, 4, 2, : 1, -1, 2, 2, 1, : -2, 1, 0, 2, 0, : -2, 1, 2, 0, 1, : 2, 1, 0, -2, 1, : -3, 0, 2, 0, 1, : -2, 0, 2, -2, 1, : -1, 1, 0, 2, 2, : 0, -1, 2, -1, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=211,220 ) / : -1, 0, 4, -2, 2, : 0, -2, 2, 0, 2, : -1, 0, 2, 1, 2, : 2, 0, 0, 0, 2, : 0, 0, 2, 0, 3, : -2, 0, 4, 0, 2, : -1, 0, -2, 0, 1, : -1, 1, 2, 2, 1, : 3, 0, 0, 0, 1, : -1, 0, 2, 3, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=221,230 ) / : 2, -1, 2, 0, 1, : 0, 1, 2, 2, 1, : 0, -1, 2, 4, 2, : 2, -1, 2, 2, 2, : 0, 2, -2, 2, 0, : -1, -1, 2, -1, 1, : 0, -2, 0, 0, 1, : 1, 0, 2, -4, 2, : 1, -1, 0, -2, 1, : -1, -1, 2, 0, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=231,240 ) / : 1, -1, 2, -2, 2, : -2, -1, 0, 4, 0, : -1, 0, 0, 3, 0, : -2, -1, 2, 2, 2, : 0, 2, 2, 0, 2, : 1, 1, 0, 2, 0, : 2, 0, 2, -1, 2, : 1, 0, 2, 1, 1, : 4, 0, 0, 0, 0, : 2, 1, 2, 0, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=241,250 ) / : 3, -1, 2, 0, 2, : -2, 2, 0, 2, 1, : 1, 0, 2, -3, 1, : 1, 1, 2, -4, 1, : -1, -1, 2, -2, 1, : 0, -1, 0, -1, 1, : 0, -1, 0, -2, 1, : -2, 0, 0, 0, 2, : -2, 0, -2, 2, 0, : -1, 0, -2, 4, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=251,260 ) / : 1, -2, 0, 0, 0, : 0, 1, 0, 1, 1, : -1, 2, 0, 2, 0, : 1, -1, 2, -2, 1, : 1, 2, 2, -2, 2, : 2, -1, 2, -2, 2, : 1, 0, 2, -1, 1, : 2, 1, 2, -2, 1, : -2, 0, 0, -2, 1, : 1, -2, 2, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=261,270 ) / : 0, 1, 2, 1, 1, : 1, 0, 4, -2, 1, : -2, 0, 4, 2, 2, : 1, 1, 2, 1, 2, : 1, 0, 0, 4, 0, : 1, 0, 2, 2, 0, : 2, 0, 2, 1, 2, : 3, 1, 2, 0, 2, : 4, 0, 2, 0, 1, : -2, -1, 2, 0, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=271,280 ) / : 0, 1, -2, 2, 1, : 1, 0, -2, 1, 0, : 0, -1, -2, 2, 1, : 2, -1, 0, -2, 1, : -1, 0, 2, -1, 2, : 1, 0, 2, -3, 2, : 0, 1, 2, -2, 3, : 0, 0, 2, -3, 1, : -1, 0, -2, 2, 1, : 0, 0, 2, -4, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=281,290 ) / : -2, 1, 0, 0, 1, : -1, 0, 0, -1, 1, : 2, 0, 2, -4, 2, : 0, 0, 4, -4, 4, : 0, 0, 4, -4, 2, : -1, -2, 0, 2, 1, : -2, 0, 0, 3, 0, : 1, 0, -2, 2, 1, : -3, 0, 2, 2, 2, : -3, 0, 2, 2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=291,300 ) / : -2, 0, 2, 2, 0, : 2, -1, 0, 0, 1, : -2, 1, 2, 2, 2, : 1, 1, 0, 1, 0, : 0, 1, 4, -2, 2, : -1, 1, 0, -2, 1, : 0, 0, 0, -4, 1, : 1, -1, 0, 2, 1, : 1, 1, 0, 2, 1, : -1, 2, 2, 2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=301,310 ) / : 3, 1, 2, -2, 2, : 0, -1, 0, 4, 0, : 2, -1, 0, 2, 0, : 0, 0, 4, 0, 1, : 2, 0, 4, -2, 2, : -1, -1, 2, 4, 1, : 1, 0, 0, 4, 1, : 1, -2, 2, 2, 2, : 0, 0, 2, 3, 2, : -1, 1, 2, 4, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=311,320 ) / : 3, 0, 0, 2, 0, : -1, 0, 4, 2, 2, : 1, 1, 2, 2, 1, : -2, 0, 2, 6, 2, : 2, 1, 2, 2, 2, : -1, 0, 2, 6, 2, : 1, 0, 2, 4, 1, : 2, 0, 2, 4, 2, : 1, 1, -2, 1, 0, : -3, 1, 2, 1, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=321,330 ) / : 2, 0, -2, 0, 2, : -1, 0, 0, 1, 2, : -4, 0, 2, 2, 1, : -1, -1, 0, 1, 0, : 0, 0, -2, 2, 2, : 1, 0, 0, -1, 2, : 0, -1, 2, -2, 3, : -2, 1, 2, 0, 0, : 0, 0, 2, -2, 4, : -2, -2, 0, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=331,340 ) / : -2, 0, -2, 4, 0, : 0, -2, -2, 2, 0, : 1, 2, 0, -2, 1, : 3, 0, 0, -4, 1, : -1, 1, 2, -2, 2, : 1, -1, 2, -4, 1, : 1, 1, 0, -2, 2, : -3, 0, 2, 0, 0, : -3, 0, 2, 0, 2, : -2, 0, 0, 1, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=341,350 ) / : 0, 0, -2, 1, 0, : -3, 0, 0, 2, 1, : -1, -1, -2, 2, 0, : 0, 1, 2, -4, 1, : 2, 1, 0, -4, 1, : 0, 2, 0, -2, 1, : 1, 0, 0, -3, 1, : -2, 0, 2, -2, 2, : -2, -1, 0, 0, 1, : -4, 0, 0, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=351,360 ) / : 1, 1, 0, -4, 1, : -1, 0, 2, -4, 1, : 0, 0, 4, -4, 1, : 0, 3, 2, -2, 2, : -3, -1, 0, 4, 0, : -3, 0, 0, 4, 1, : 1, -1, -2, 2, 0, : -1, -1, 0, 2, 2, : 1, -2, 0, 0, 1, : 1, -1, 0, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=361,370 ) / : 0, 0, 0, 1, 2, : -1, -1, 2, 0, 0, : 1, -2, 2, -2, 2, : 0, -1, 2, -1, 1, : -1, 0, 2, 0, 3, : 1, 1, 0, 0, 2, : -1, 1, 2, 0, 0, : 1, 2, 0, 0, 0, : -1, 2, 2, 0, 2, : -1, 0, 4, -2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=371,380 ) / : 3, 0, 2, -4, 2, : 1, 2, 2, -2, 1, : 1, 0, 4, -4, 2, : -2, -1, 0, 4, 1, : 0, -1, 0, 2, 2, : -2, 1, 0, 4, 0, : -2, -1, 2, 2, 1, : 2, 0, -2, 2, 0, : 1, 0, 0, 1, 1, : 0, 1, 0, 2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=381,390 ) / : 1, -1, 2, -1, 2, : -2, 0, 4, 0, 1, : 2, 1, 0, 0, 1, : 0, 1, 2, 0, 0, : 0, -1, 4, -2, 2, : 0, 0, 4, -2, 4, : 0, 2, 2, 0, 1, : -3, 0, 0, 6, 0, : -1, -1, 0, 4, 1, : 1, -2, 0, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=391,400 ) / : -1, 0, 0, 4, 2, : -1, -2, 2, 2, 1, : -1, 0, 0, -2, 2, : 1, 0, -2, -2, 1, : 0, 0, -2, -2, 1, : -2, 0, -2, 0, 1, : 0, 0, 0, 3, 1, : 0, 0, 0, 3, 0, : -1, 1, 0, 4, 0, : -1, -1, 2, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=401,410 ) / : -2, 0, 2, 3, 2, : 1, 0, 0, 2, 2, : 0, -1, 2, 1, 2, : 3, -1, 0, 0, 0, : 2, 0, 0, 1, 0, : 1, -1, 2, 0, 0, : 0, 0, 2, 1, 0, : 1, 0, 2, 0, 3, : 3, 1, 0, 0, 0, : 3, -1, 2, -2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=411,420 ) / : 2, 0, 2, -1, 1, : 1, 1, 2, 0, 0, : 0, 0, 4, -1, 2, : 1, 2, 2, 0, 2, : -2, 0, 0, 6, 0, : 0, -1, 0, 4, 1, : -2, -1, 2, 4, 1, : 0, -2, 2, 2, 1, : 0, -1, 2, 2, 0, : -1, 0, 2, 3, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=421,430 ) / : -2, 1, 2, 4, 2, : 2, 0, 0, 2, 2, : 2, -2, 2, 0, 2, : -1, 1, 2, 3, 2, : 3, 0, 2, -1, 2, : 4, 0, 2, -2, 1, : -1, 0, 0, 6, 0, : -1, -2, 2, 4, 2, : -3, 0, 2, 6, 2, : -1, 0, 2, 4, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=431,440 ) / : 3, 0, 0, 2, 1, : 3, -1, 2, 0, 1, : 3, 0, 2, 0, 0, : 1, 0, 4, 0, 2, : 5, 0, 2, -2, 2, : 0, -1, 2, 4, 1, : 2, -1, 2, 2, 1, : 0, 1, 2, 4, 2, : 1, -1, 2, 4, 2, : 3, -1, 2, 2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=441,450 ) / : 3, 0, 2, 2, 1, : 5, 0, 2, 0, 2, : 0, 0, 2, 6, 2, : 4, 0, 2, 2, 2, : 0, -1, 1, -1, 1, : -1, 0, 1, 0, 3, : 0, -2, 2, -2, 3, : 1, 0, -1, 0, 1, : 2, -2, 0, -2, 1, : -1, 0, 1, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=451,460 ) / : -1, 0, 1, 0, 1, : -1, -1, 2, -1, 2, : -2, 2, 0, 2, 2, : -1, 0, 1, 0, 0, : -4, 1, 2, 2, 2, : -3, 0, 2, 1, 1, : -2, -1, 2, 0, 2, : 1, 0, -2, 1, 1, : 2, -1, -2, 0, 1, : -4, 0, 2, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=461,470 ) / : -3, 1, 0, 3, 0, : -1, 0, -1, 2, 0, : 0, -2, 0, 0, 2, : 0, -2, 0, 0, 2, : -3, 0, 0, 3, 0, : -2, -1, 0, 2, 2, : -1, 0, -2, 3, 0, : -4, 0, 0, 4, 0, : 2, 1, -2, 0, 1, : 2, -1, 0, -2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=471,480 ) / : 0, 0, 1, -1, 0, : -1, 2, 0, 1, 0, : -2, 1, 2, 0, 2, : 1, 1, 0, -1, 1, : 1, 0, 1, -2, 1, : 0, 2, 0, 0, 2, : 1, -1, 2, -3, 1, : -1, 1, 2, -1, 1, : -2, 0, 4, -2, 2, : -2, 0, 4, -2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=481,490 ) / : -2, -2, 0, 2, 1, : -2, 0, -2, 4, 0, : 1, 2, 2, -4, 1, : 1, 1, 2, -4, 2, : -1, 2, 2, -2, 1, : 2, 0, 0, -3, 1, : -1, 2, 0, 0, 1, : 0, 0, 0, -2, 0, : -1, -1, 2, -2, 2, : -1, 1, 0, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=491,500 ) / : 0, 0, 0, -1, 2, : -2, 1, 0, 1, 0, : 1, -2, 0, -2, 1, : 1, 0, -2, 0, 2, : -3, 1, 0, 2, 0, : -1, 1, -2, 2, 0, : -1, -1, 0, 0, 2, : -3, 0, 0, 2, 0, : -3, -1, 0, 2, 0, : 2, 0, 2, -6, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=501,510 ) / : 0, 1, 2, -4, 2, : 2, 0, 0, -4, 2, : -2, 1, 2, -2, 1, : 0, -1, 2, -4, 1, : 0, 1, 0, -2, 2, : -1, 0, 0, -2, 0, : 2, 0, -2, -2, 1, : -4, 0, 2, 0, 1, : -1, -1, 0, -1, 1, : 0, 0, -2, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=511,520 ) / : -3, 0, 0, 1, 0, : -1, 0, -2, 1, 0, : -2, 0, -2, 2, 1, : 0, 0, -4, 2, 0, : -2, -1, -2, 2, 0, : 1, 0, 2, -6, 1, : -1, 0, 2, -4, 2, : 1, 0, 0, -4, 2, : 2, 1, 2, -4, 2, : 2, 1, 2, -4, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=521,530 ) / : 0, 1, 4, -4, 4, : 0, 1, 4, -4, 2, : -1, -1, -2, 4, 0, : -1, -3, 0, 2, 0, : -1, 0, -2, 4, 1, : -2, -1, 0, 3, 0, : 0, 0, -2, 3, 0, : -2, 0, 0, 3, 1, : 0, -1, 0, 1, 0, : -3, 0, 2, 2, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=531,540 ) / : 1, 1, -2, 2, 0, : -1, 1, 0, 2, 2, : 1, -2, 2, -2, 1, : 0, 0, 1, 0, 2, : 0, 0, 1, 0, 1, : 0, 0, 1, 0, 0, : -1, 2, 0, 2, 1, : 0, 0, 2, 0, 2, : -2, 0, 2, 0, 2, : 2, 0, 0, -1, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=541,550 ) / : 3, 0, 0, -2, 1, : 1, 0, 2, -2, 3, : 1, 2, 0, 0, 1, : 2, 0, 2, -3, 2, : -1, 1, 4, -2, 2, : -2, -2, 0, 4, 0, : 0, -3, 0, 2, 0, : 0, 0, -2, 4, 0, : -1, -1, 0, 3, 0, : -2, 0, 0, 4, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=551,560 ) / : -1, 0, 0, 3, 1, : 2, -2, 0, 0, 0, : 1, -1, 0, 1, 0, : -1, 0, 0, 2, 0, : 0, -2, 2, 0, 1, : -1, 0, 1, 2, 1, : -1, 1, 0, 3, 0, : -1, -1, 2, 1, 2, : 0, -1, 2, 0, 0, : -2, 1, 2, 2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=561,570 ) / : 2, -2, 2, -2, 2, : 1, 1, 0, 1, 1, : 1, 0, 1, 0, 1, : 1, 0, 1, 0, 0, : 0, 2, 0, 2, 0, : 2, -1, 2, -2, 1, : 0, -1, 4, -2, 1, : 0, 0, 4, -2, 3, : 0, 1, 4, -2, 1, : 4, 0, 2, -4, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=571,580 ) / : 2, 2, 2, -2, 2, : 2, 0, 4, -4, 2, : -1, -2, 0, 4, 0, : -1, -3, 2, 2, 2, : -3, 0, 2, 4, 2, : -3, 0, 2, -2, 1, : -1, -1, 0, -2, 1, : -3, 0, 0, 0, 2, : -3, 0, -2, 2, 0, : 0, 1, 0, -4, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=581,590 ) / : -2, 1, 0, -2, 1, : -4, 0, 0, 0, 1, : -1, 0, 0, -4, 1, : -3, 0, 0, -2, 1, : 0, 0, 0, 3, 2, : -1, 1, 0, 4, 1, : 1, -2, 2, 0, 1, : 0, 1, 0, 3, 0, : -1, 0, 2, 2, 3, : 0, 0, 2, 2, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=591,600 ) / : -2, 0, 2, 2, 2, : -1, 1, 2, 2, 0, : 3, 0, 0, 0, 2, : 2, 1, 0, 1, 0, : 2, -1, 2, -1, 2, : 0, 0, 2, 0, 1, : 0, 0, 3, 0, 3, : 0, 0, 3, 0, 2, : -1, 2, 2, 2, 1, : -1, 0, 4, 0, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=601,610 ) / : 1, 2, 2, 0, 1, : 3, 1, 2, -2, 1, : 1, 1, 4, -2, 2, : -2, -1, 0, 6, 0, : 0, -2, 0, 4, 0, : -2, 0, 0, 6, 1, : -2, -2, 2, 4, 2, : 0, -3, 2, 2, 2, : 0, 0, 0, 4, 2, : -1, -1, 2, 3, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=611,620 ) / : -2, 0, 2, 4, 0, : 2, -1, 0, 2, 1, : 1, 0, 0, 3, 0, : 0, 1, 0, 4, 1, : 0, 1, 0, 4, 0, : 1, -1, 2, 1, 2, : 0, 0, 2, 2, 3, : 1, 0, 2, 2, 2, : -1, 0, 2, 2, 2, : -2, 0, 4, 2, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=621,630 ) / : 2, 1, 0, 2, 1, : 2, 1, 0, 2, 0, : 2, -1, 2, 0, 0, : 1, 0, 2, 1, 0, : 0, 1, 2, 2, 0, : 2, 0, 2, 0, 3, : 3, 0, 2, 0, 2, : 1, 0, 2, 0, 2, : 1, 0, 3, 0, 3, : 1, 1, 2, 1, 1 / DATA ( ( NALS(I,J), I=1,5 ), J=631,640 ) / : 0, 2, 2, 2, 2, : 2, 1, 2, 0, 0, : 2, 0, 4, -2, 1, : 4, 1, 2, -2, 2, : -1, -1, 0, 6, 0, : -3, -1, 2, 6, 2, : -1, 0, 0, 6, 1, : -3, 0, 2, 6, 1, : 1, -1, 0, 4, 1, : 1, -1, 0, 4, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=641,650 ) / : -2, 0, 2, 5, 2, : 1, -2, 2, 2, 1, : 3, -1, 0, 2, 0, : 1, -1, 2, 2, 0, : 0, 0, 2, 3, 1, : -1, 1, 2, 4, 1, : 0, 1, 2, 3, 2, : -1, 0, 4, 2, 1, : 2, 0, 2, 1, 1, : 5, 0, 0, 0, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=651,660 ) / : 2, 1, 2, 1, 2, : 1, 0, 4, 0, 1, : 3, 1, 2, 0, 1, : 3, 0, 4, -2, 2, : -2, -1, 2, 6, 2, : 0, 0, 0, 6, 0, : 0, -2, 2, 4, 2, : -2, 0, 2, 6, 1, : 2, 0, 0, 4, 1, : 2, 0, 0, 4, 0 / DATA ( ( NALS(I,J), I=1,5 ), J=661,670 ) / : 2, -2, 2, 2, 2, : 0, 0, 2, 4, 0, : 1, 0, 2, 3, 2, : 4, 0, 0, 2, 0, : 2, 0, 2, 2, 0, : 0, 0, 4, 2, 2, : 4, -1, 2, 0, 2, : 3, 0, 2, 1, 2, : 2, 1, 2, 2, 1, : 4, 1, 2, 0, 2 / DATA ( ( NALS(I,J), I=1,5 ), J=671,678 ) / : -1, -1, 2, 6, 2, : -1, 0, 2, 6, 1, : 1, -1, 2, 4, 1, : 1, 1, 2, 4, 2, : 3, 1, 2, 2, 2, : 5, 0, 2, 0, 1, : 2, -1, 2, 4, 2, : 2, 0, 2, 4, 1 / * * Luni-Solar nutation coefficients, unit 1e-7 arcsec * longitude (sin, t*sin, cos), obliquity (cos, t*cos, sin) * DATA ( ( CLS(I,J), I=1,6 ), J= 1, 10 ) / : -172064161D0, -174666D0, 33386D0, 92052331D0, 9086D0, 15377D0, : -13170906D0, -1675D0, -13696D0, 5730336D0, -3015D0, -4587D0, : -2276413D0, -234D0, 2796D0, 978459D0, -485D0, 1374D0, : 2074554D0, 207D0, -698D0, -897492D0, 470D0, -291D0, : 1475877D0, -3633D0, 11817D0, 73871D0, -184D0, -1924D0, : -516821D0, 1226D0, -524D0, 224386D0, -677D0, -174D0, : 711159D0, 73D0, -872D0, -6750D0, 0D0, 358D0, : -387298D0, -367D0, 380D0, 200728D0, 18D0, 318D0, : -301461D0, -36D0, 816D0, 129025D0, -63D0, 367D0, : 215829D0, -494D0, 111D0, -95929D0, 299D0, 132D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 11, 20 ) / : 128227D0, 137D0, 181D0, -68982D0, -9D0, 39D0, : 123457D0, 11D0, 19D0, -53311D0, 32D0, -4D0, : 156994D0, 10D0, -168D0, -1235D0, 0D0, 82D0, : 63110D0, 63D0, 27D0, -33228D0, 0D0, -9D0, : -57976D0, -63D0, -189D0, 31429D0, 0D0, -75D0, : -59641D0, -11D0, 149D0, 25543D0, -11D0, 66D0, : -51613D0, -42D0, 129D0, 26366D0, 0D0, 78D0, : 45893D0, 50D0, 31D0, -24236D0, -10D0, 20D0, : 63384D0, 11D0, -150D0, -1220D0, 0D0, 29D0, : -38571D0, -1D0, 158D0, 16452D0, -11D0, 68D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 21, 30 ) / : 32481D0, 0D0, 0D0, -13870D0, 0D0, 0D0, : -47722D0, 0D0, -18D0, 477D0, 0D0, -25D0, : -31046D0, -1D0, 131D0, 13238D0, -11D0, 59D0, : 28593D0, 0D0, -1D0, -12338D0, 10D0, -3D0, : 20441D0, 21D0, 10D0, -10758D0, 0D0, -3D0, : 29243D0, 0D0, -74D0, -609D0, 0D0, 13D0, : 25887D0, 0D0, -66D0, -550D0, 0D0, 11D0, : -14053D0, -25D0, 79D0, 8551D0, -2D0, -45D0, : 15164D0, 10D0, 11D0, -8001D0, 0D0, -1D0, : -15794D0, 72D0, -16D0, 6850D0, -42D0, -5D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 31, 40 ) / : 21783D0, 0D0, 13D0, -167D0, 0D0, 13D0, : -12873D0, -10D0, -37D0, 6953D0, 0D0, -14D0, : -12654D0, 11D0, 63D0, 6415D0, 0D0, 26D0, : -10204D0, 0D0, 25D0, 5222D0, 0D0, 15D0, : 16707D0, -85D0, -10D0, 168D0, -1D0, 10D0, : -7691D0, 0D0, 44D0, 3268D0, 0D0, 19D0, : -11024D0, 0D0, -14D0, 104D0, 0D0, 2D0, : 7566D0, -21D0, -11D0, -3250D0, 0D0, -5D0, : -6637D0, -11D0, 25D0, 3353D0, 0D0, 14D0, : -7141D0, 21D0, 8D0, 3070D0, 0D0, 4D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 41, 50 ) / : -6302D0, -11D0, 2D0, 3272D0, 0D0, 4D0, : 5800D0, 10D0, 2D0, -3045D0, 0D0, -1D0, : 6443D0, 0D0, -7D0, -2768D0, 0D0, -4D0, : -5774D0, -11D0, -15D0, 3041D0, 0D0, -5D0, : -5350D0, 0D0, 21D0, 2695D0, 0D0, 12D0, : -4752D0, -11D0, -3D0, 2719D0, 0D0, -3D0, : -4940D0, -11D0, -21D0, 2720D0, 0D0, -9D0, : 7350D0, 0D0, -8D0, -51D0, 0D0, 4D0, : 4065D0, 0D0, 6D0, -2206D0, 0D0, 1D0, : 6579D0, 0D0, -24D0, -199D0, 0D0, 2D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 51, 60 ) / : 3579D0, 0D0, 5D0, -1900D0, 0D0, 1D0, : 4725D0, 0D0, -6D0, -41D0, 0D0, 3D0, : -3075D0, 0D0, -2D0, 1313D0, 0D0, -1D0, : -2904D0, 0D0, 15D0, 1233D0, 0D0, 7D0, : 4348D0, 0D0, -10D0, -81D0, 0D0, 2D0, : -2878D0, 0D0, 8D0, 1232D0, 0D0, 4D0, : -4230D0, 0D0, 5D0, -20D0, 0D0, -2D0, : -2819D0, 0D0, 7D0, 1207D0, 0D0, 3D0, : -4056D0, 0D0, 5D0, 40D0, 0D0, -2D0, : -2647D0, 0D0, 11D0, 1129D0, 0D0, 5D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 61, 70 ) / : -2294D0, 0D0, -10D0, 1266D0, 0D0, -4D0, : 2481D0, 0D0, -7D0, -1062D0, 0D0, -3D0, : 2179D0, 0D0, -2D0, -1129D0, 0D0, -2D0, : 3276D0, 0D0, 1D0, -9D0, 0D0, 0D0, : -3389D0, 0D0, 5D0, 35D0, 0D0, -2D0, : 3339D0, 0D0, -13D0, -107D0, 0D0, 1D0, : -1987D0, 0D0, -6D0, 1073D0, 0D0, -2D0, : -1981D0, 0D0, 0D0, 854D0, 0D0, 0D0, : 4026D0, 0D0, -353D0, -553D0, 0D0, -139D0, : 1660D0, 0D0, -5D0, -710D0, 0D0, -2D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 71, 80 ) / : -1521D0, 0D0, 9D0, 647D0, 0D0, 4D0, : 1314D0, 0D0, 0D0, -700D0, 0D0, 0D0, : -1283D0, 0D0, 0D0, 672D0, 0D0, 0D0, : -1331D0, 0D0, 8D0, 663D0, 0D0, 4D0, : 1383D0, 0D0, -2D0, -594D0, 0D0, -2D0, : 1405D0, 0D0, 4D0, -610D0, 0D0, 2D0, : 1290D0, 0D0, 0D0, -556D0, 0D0, 0D0, : -1214D0, 0D0, 5D0, 518D0, 0D0, 2D0, : 1146D0, 0D0, -3D0, -490D0, 0D0, -1D0, : 1019D0, 0D0, -1D0, -527D0, 0D0, -1D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 81, 90 ) / : -1100D0, 0D0, 9D0, 465D0, 0D0, 4D0, : -970D0, 0D0, 2D0, 496D0, 0D0, 1D0, : 1575D0, 0D0, -6D0, -50D0, 0D0, 0D0, : 934D0, 0D0, -3D0, -399D0, 0D0, -1D0, : 922D0, 0D0, -1D0, -395D0, 0D0, -1D0, : 815D0, 0D0, -1D0, -422D0, 0D0, -1D0, : 834D0, 0D0, 2D0, -440D0, 0D0, 1D0, : 1248D0, 0D0, 0D0, -170D0, 0D0, 1D0, : 1338D0, 0D0, -5D0, -39D0, 0D0, 0D0, : 716D0, 0D0, -2D0, -389D0, 0D0, -1D0 / DATA ( ( CLS(I,J), I=1,6 ), J= 91,100 ) / : 1282D0, 0D0, -3D0, -23D0, 0D0, 1D0, : 742D0, 0D0, 1D0, -391D0, 0D0, 0D0, : 1020D0, 0D0, -25D0, -495D0, 0D0, -10D0, : 715D0, 0D0, -4D0, -326D0, 0D0, 2D0, : -666D0, 0D0, -3D0, 369D0, 0D0, -1D0, : -667D0, 0D0, 1D0, 346D0, 0D0, 1D0, : -704D0, 0D0, 0D0, 304D0, 0D0, 0D0, : -694D0, 0D0, 5D0, 294D0, 0D0, 2D0, : -1014D0, 0D0, -1D0, 4D0, 0D0, -1D0, : -585D0, 0D0, -2D0, 316D0, 0D0, -1D0 / DATA ( ( CLS(I,J), I=1,6 ), J=101,110 ) / : -949D0, 0D0, 1D0, 8D0, 0D0, -1D0, : -595D0, 0D0, 0D0, 258D0, 0D0, 0D0, : 528D0, 0D0, 0D0, -279D0, 0D0, 0D0, : -590D0, 0D0, 4D0, 252D0, 0D0, 2D0, : 570D0, 0D0, -2D0, -244D0, 0D0, -1D0, : -502D0, 0D0, 3D0, 250D0, 0D0, 2D0, : -875D0, 0D0, 1D0, 29D0, 0D0, 0D0, : -492D0, 0D0, -3D0, 275D0, 0D0, -1D0, : 535D0, 0D0, -2D0, -228D0, 0D0, -1D0, : -467D0, 0D0, 1D0, 240D0, 0D0, 1D0 / DATA ( ( CLS(I,J), I=1,6 ), J=111,120 ) / : 591D0, 0D0, 0D0, -253D0, 0D0, 0D0, : -453D0, 0D0, -1D0, 244D0, 0D0, -1D0, : 766D0, 0D0, 1D0, 9D0, 0D0, 0D0, : -446D0, 0D0, 2D0, 225D0, 0D0, 1D0, : -488D0, 0D0, 2D0, 207D0, 0D0, 1D0, : -468D0, 0D0, 0D0, 201D0, 0D0, 0D0, : -421D0, 0D0, 1D0, 216D0, 0D0, 1D0, : 463D0, 0D0, 0D0, -200D0, 0D0, 0D0, : -673D0, 0D0, 2D0, 14D0, 0D0, 0D0, : 658D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=121,130 ) / : -438D0, 0D0, 0D0, 188D0, 0D0, 0D0, : -390D0, 0D0, 0D0, 205D0, 0D0, 0D0, : 639D0, -11D0, -2D0, -19D0, 0D0, 0D0, : 412D0, 0D0, -2D0, -176D0, 0D0, -1D0, : -361D0, 0D0, 0D0, 189D0, 0D0, 0D0, : 360D0, 0D0, -1D0, -185D0, 0D0, -1D0, : 588D0, 0D0, -3D0, -24D0, 0D0, 0D0, : -578D0, 0D0, 1D0, 5D0, 0D0, 0D0, : -396D0, 0D0, 0D0, 171D0, 0D0, 0D0, : 565D0, 0D0, -1D0, -6D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=131,140 ) / : -335D0, 0D0, -1D0, 184D0, 0D0, -1D0, : 357D0, 0D0, 1D0, -154D0, 0D0, 0D0, : 321D0, 0D0, 1D0, -174D0, 0D0, 0D0, : -301D0, 0D0, -1D0, 162D0, 0D0, 0D0, : -334D0, 0D0, 0D0, 144D0, 0D0, 0D0, : 493D0, 0D0, -2D0, -15D0, 0D0, 0D0, : 494D0, 0D0, -2D0, -19D0, 0D0, 0D0, : 337D0, 0D0, -1D0, -143D0, 0D0, -1D0, : 280D0, 0D0, -1D0, -144D0, 0D0, 0D0, : 309D0, 0D0, 1D0, -134D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=141,150 ) / : -263D0, 0D0, 2D0, 131D0, 0D0, 1D0, : 253D0, 0D0, 1D0, -138D0, 0D0, 0D0, : 245D0, 0D0, 0D0, -128D0, 0D0, 0D0, : 416D0, 0D0, -2D0, -17D0, 0D0, 0D0, : -229D0, 0D0, 0D0, 128D0, 0D0, 0D0, : 231D0, 0D0, 0D0, -120D0, 0D0, 0D0, : -259D0, 0D0, 2D0, 109D0, 0D0, 1D0, : 375D0, 0D0, -1D0, -8D0, 0D0, 0D0, : 252D0, 0D0, 0D0, -108D0, 0D0, 0D0, : -245D0, 0D0, 1D0, 104D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=151,160 ) / : 243D0, 0D0, -1D0, -104D0, 0D0, 0D0, : 208D0, 0D0, 1D0, -112D0, 0D0, 0D0, : 199D0, 0D0, 0D0, -102D0, 0D0, 0D0, : -208D0, 0D0, 1D0, 105D0, 0D0, 0D0, : 335D0, 0D0, -2D0, -14D0, 0D0, 0D0, : -325D0, 0D0, 1D0, 7D0, 0D0, 0D0, : -187D0, 0D0, 0D0, 96D0, 0D0, 0D0, : 197D0, 0D0, -1D0, -100D0, 0D0, 0D0, : -192D0, 0D0, 2D0, 94D0, 0D0, 1D0, : -188D0, 0D0, 0D0, 83D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=161,170 ) / : 276D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -286D0, 0D0, 1D0, 6D0, 0D0, 0D0, : 186D0, 0D0, -1D0, -79D0, 0D0, 0D0, : -219D0, 0D0, 0D0, 43D0, 0D0, 0D0, : 276D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -153D0, 0D0, -1D0, 84D0, 0D0, 0D0, : -156D0, 0D0, 0D0, 81D0, 0D0, 0D0, : -154D0, 0D0, 1D0, 78D0, 0D0, 0D0, : -174D0, 0D0, 1D0, 75D0, 0D0, 0D0, : -163D0, 0D0, 2D0, 69D0, 0D0, 1D0 / DATA ( ( CLS(I,J), I=1,6 ), J=171,180 ) / : -228D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 91D0, 0D0, -4D0, -54D0, 0D0, -2D0, : 175D0, 0D0, 0D0, -75D0, 0D0, 0D0, : -159D0, 0D0, 0D0, 69D0, 0D0, 0D0, : 141D0, 0D0, 0D0, -72D0, 0D0, 0D0, : 147D0, 0D0, 0D0, -75D0, 0D0, 0D0, : -132D0, 0D0, 0D0, 69D0, 0D0, 0D0, : 159D0, 0D0, -28D0, -54D0, 0D0, 11D0, : 213D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 123D0, 0D0, 0D0, -64D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=181,190 ) / : -118D0, 0D0, -1D0, 66D0, 0D0, 0D0, : 144D0, 0D0, -1D0, -61D0, 0D0, 0D0, : -121D0, 0D0, 1D0, 60D0, 0D0, 0D0, : -134D0, 0D0, 1D0, 56D0, 0D0, 1D0, : -105D0, 0D0, 0D0, 57D0, 0D0, 0D0, : -102D0, 0D0, 0D0, 56D0, 0D0, 0D0, : 120D0, 0D0, 0D0, -52D0, 0D0, 0D0, : 101D0, 0D0, 0D0, -54D0, 0D0, 0D0, : -113D0, 0D0, 0D0, 59D0, 0D0, 0D0, : -106D0, 0D0, 0D0, 61D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=191,200 ) / : -129D0, 0D0, 1D0, 55D0, 0D0, 0D0, : -114D0, 0D0, 0D0, 57D0, 0D0, 0D0, : 113D0, 0D0, -1D0, -49D0, 0D0, 0D0, : -102D0, 0D0, 0D0, 44D0, 0D0, 0D0, : -94D0, 0D0, 0D0, 51D0, 0D0, 0D0, : -100D0, 0D0, -1D0, 56D0, 0D0, 0D0, : 87D0, 0D0, 0D0, -47D0, 0D0, 0D0, : 161D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 96D0, 0D0, 0D0, -50D0, 0D0, 0D0, : 151D0, 0D0, -1D0, -5D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=201,210 ) / : -104D0, 0D0, 0D0, 44D0, 0D0, 0D0, : -110D0, 0D0, 0D0, 48D0, 0D0, 0D0, : -100D0, 0D0, 1D0, 50D0, 0D0, 0D0, : 92D0, 0D0, -5D0, 12D0, 0D0, -2D0, : 82D0, 0D0, 0D0, -45D0, 0D0, 0D0, : 82D0, 0D0, 0D0, -45D0, 0D0, 0D0, : -78D0, 0D0, 0D0, 41D0, 0D0, 0D0, : -77D0, 0D0, 0D0, 43D0, 0D0, 0D0, : 2D0, 0D0, 0D0, 54D0, 0D0, 0D0, : 94D0, 0D0, 0D0, -40D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=211,220 ) / : -93D0, 0D0, 0D0, 40D0, 0D0, 0D0, : -83D0, 0D0, 10D0, 40D0, 0D0, -2D0, : 83D0, 0D0, 0D0, -36D0, 0D0, 0D0, : -91D0, 0D0, 0D0, 39D0, 0D0, 0D0, : 128D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -79D0, 0D0, 0D0, 34D0, 0D0, 0D0, : -83D0, 0D0, 0D0, 47D0, 0D0, 0D0, : 84D0, 0D0, 0D0, -44D0, 0D0, 0D0, : 83D0, 0D0, 0D0, -43D0, 0D0, 0D0, : 91D0, 0D0, 0D0, -39D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=221,230 ) / : -77D0, 0D0, 0D0, 39D0, 0D0, 0D0, : 84D0, 0D0, 0D0, -43D0, 0D0, 0D0, : -92D0, 0D0, 1D0, 39D0, 0D0, 0D0, : -92D0, 0D0, 1D0, 39D0, 0D0, 0D0, : -94D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 68D0, 0D0, 0D0, -36D0, 0D0, 0D0, : -61D0, 0D0, 0D0, 32D0, 0D0, 0D0, : 71D0, 0D0, 0D0, -31D0, 0D0, 0D0, : 62D0, 0D0, 0D0, -34D0, 0D0, 0D0, : -63D0, 0D0, 0D0, 33D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=231,240 ) / : -73D0, 0D0, 0D0, 32D0, 0D0, 0D0, : 115D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -103D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 63D0, 0D0, 0D0, -28D0, 0D0, 0D0, : 74D0, 0D0, 0D0, -32D0, 0D0, 0D0, : -103D0, 0D0, -3D0, 3D0, 0D0, -1D0, : -69D0, 0D0, 0D0, 30D0, 0D0, 0D0, : 57D0, 0D0, 0D0, -29D0, 0D0, 0D0, : 94D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 64D0, 0D0, 0D0, -33D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=241,250 ) / : -63D0, 0D0, 0D0, 26D0, 0D0, 0D0, : -38D0, 0D0, 0D0, 20D0, 0D0, 0D0, : -43D0, 0D0, 0D0, 24D0, 0D0, 0D0, : -45D0, 0D0, 0D0, 23D0, 0D0, 0D0, : 47D0, 0D0, 0D0, -24D0, 0D0, 0D0, : -48D0, 0D0, 0D0, 25D0, 0D0, 0D0, : 45D0, 0D0, 0D0, -26D0, 0D0, 0D0, : 56D0, 0D0, 0D0, -25D0, 0D0, 0D0, : 88D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -75D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=251,260 ) / : 85D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 49D0, 0D0, 0D0, -26D0, 0D0, 0D0, : -74D0, 0D0, -3D0, -1D0, 0D0, -1D0, : -39D0, 0D0, 0D0, 21D0, 0D0, 0D0, : 45D0, 0D0, 0D0, -20D0, 0D0, 0D0, : 51D0, 0D0, 0D0, -22D0, 0D0, 0D0, : -40D0, 0D0, 0D0, 21D0, 0D0, 0D0, : 41D0, 0D0, 0D0, -21D0, 0D0, 0D0, : -42D0, 0D0, 0D0, 24D0, 0D0, 0D0, : -51D0, 0D0, 0D0, 22D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=261,270 ) / : -42D0, 0D0, 0D0, 22D0, 0D0, 0D0, : 39D0, 0D0, 0D0, -21D0, 0D0, 0D0, : 46D0, 0D0, 0D0, -18D0, 0D0, 0D0, : -53D0, 0D0, 0D0, 22D0, 0D0, 0D0, : 82D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 81D0, 0D0, -1D0, -4D0, 0D0, 0D0, : 47D0, 0D0, 0D0, -19D0, 0D0, 0D0, : 53D0, 0D0, 0D0, -23D0, 0D0, 0D0, : -45D0, 0D0, 0D0, 22D0, 0D0, 0D0, : -44D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=271,280 ) / : -33D0, 0D0, 0D0, 16D0, 0D0, 0D0, : -61D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 28D0, 0D0, 0D0, -15D0, 0D0, 0D0, : -38D0, 0D0, 0D0, 19D0, 0D0, 0D0, : -33D0, 0D0, 0D0, 21D0, 0D0, 0D0, : -60D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 48D0, 0D0, 0D0, -10D0, 0D0, 0D0, : 27D0, 0D0, 0D0, -14D0, 0D0, 0D0, : 38D0, 0D0, 0D0, -20D0, 0D0, 0D0, : 31D0, 0D0, 0D0, -13D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=281,290 ) / : -29D0, 0D0, 0D0, 15D0, 0D0, 0D0, : 28D0, 0D0, 0D0, -15D0, 0D0, 0D0, : -32D0, 0D0, 0D0, 15D0, 0D0, 0D0, : 45D0, 0D0, 0D0, -8D0, 0D0, 0D0, : -44D0, 0D0, 0D0, 19D0, 0D0, 0D0, : 28D0, 0D0, 0D0, -15D0, 0D0, 0D0, : -51D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -36D0, 0D0, 0D0, 20D0, 0D0, 0D0, : 44D0, 0D0, 0D0, -19D0, 0D0, 0D0, : 26D0, 0D0, 0D0, -14D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=291,300 ) / : -60D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 35D0, 0D0, 0D0, -18D0, 0D0, 0D0, : -27D0, 0D0, 0D0, 11D0, 0D0, 0D0, : 47D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 36D0, 0D0, 0D0, -15D0, 0D0, 0D0, : -36D0, 0D0, 0D0, 20D0, 0D0, 0D0, : -35D0, 0D0, 0D0, 19D0, 0D0, 0D0, : -37D0, 0D0, 0D0, 19D0, 0D0, 0D0, : 32D0, 0D0, 0D0, -16D0, 0D0, 0D0, : 35D0, 0D0, 0D0, -14D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=301,310 ) / : 32D0, 0D0, 0D0, -13D0, 0D0, 0D0, : 65D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 47D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 32D0, 0D0, 0D0, -16D0, 0D0, 0D0, : 37D0, 0D0, 0D0, -16D0, 0D0, 0D0, : -30D0, 0D0, 0D0, 15D0, 0D0, 0D0, : -32D0, 0D0, 0D0, 16D0, 0D0, 0D0, : -31D0, 0D0, 0D0, 13D0, 0D0, 0D0, : 37D0, 0D0, 0D0, -16D0, 0D0, 0D0, : 31D0, 0D0, 0D0, -13D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=311,320 ) / : 49D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 32D0, 0D0, 0D0, -13D0, 0D0, 0D0, : 23D0, 0D0, 0D0, -12D0, 0D0, 0D0, : -43D0, 0D0, 0D0, 18D0, 0D0, 0D0, : 26D0, 0D0, 0D0, -11D0, 0D0, 0D0, : -32D0, 0D0, 0D0, 14D0, 0D0, 0D0, : -29D0, 0D0, 0D0, 14D0, 0D0, 0D0, : -27D0, 0D0, 0D0, 12D0, 0D0, 0D0, : 30D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -11D0, 0D0, 0D0, 5D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=321,330 ) / : -21D0, 0D0, 0D0, 10D0, 0D0, 0D0, : -34D0, 0D0, 0D0, 15D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 6D0, 0D0, 0D0, : -36D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -9D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 5D0, 0D0, 0D0, : -21D0, 0D0, 0D0, 5D0, 0D0, 0D0, : -29D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -15D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -20D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=331,340 ) / : 28D0, 0D0, 0D0, 0D0, 0D0, -2D0, : 17D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -22D0, 0D0, 0D0, 12D0, 0D0, 0D0, : -14D0, 0D0, 0D0, 7D0, 0D0, 0D0, : 24D0, 0D0, 0D0, -11D0, 0D0, 0D0, : 11D0, 0D0, 0D0, -6D0, 0D0, 0D0, : 14D0, 0D0, 0D0, -6D0, 0D0, 0D0, : 24D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 18D0, 0D0, 0D0, -8D0, 0D0, 0D0, : -38D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=341,350 ) / : -31D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -16D0, 0D0, 0D0, 8D0, 0D0, 0D0, : 29D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -18D0, 0D0, 0D0, 10D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 5D0, 0D0, 0D0, : -17D0, 0D0, 0D0, 10D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 16D0, 0D0, 0D0, -6D0, 0D0, 0D0, : 22D0, 0D0, 0D0, -12D0, 0D0, 0D0, : 20D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=351,360 ) / : -13D0, 0D0, 0D0, 6D0, 0D0, 0D0, : -17D0, 0D0, 0D0, 9D0, 0D0, 0D0, : -14D0, 0D0, 0D0, 8D0, 0D0, 0D0, : 0D0, 0D0, 0D0, -7D0, 0D0, 0D0, : 14D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 19D0, 0D0, 0D0, -10D0, 0D0, 0D0, : -34D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -20D0, 0D0, 0D0, 8D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -5D0, 0D0, 0D0, : -18D0, 0D0, 0D0, 7D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=361,370 ) / : 13D0, 0D0, 0D0, -6D0, 0D0, 0D0, : 17D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 5D0, 0D0, 0D0, : 15D0, 0D0, 0D0, -8D0, 0D0, 0D0, : -11D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 13D0, 0D0, 0D0, -5D0, 0D0, 0D0, : -18D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -35D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -4D0, 0D0, 0D0, : -19D0, 0D0, 0D0, 10D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=371,380 ) / : -26D0, 0D0, 0D0, 11D0, 0D0, 0D0, : 8D0, 0D0, 0D0, -4D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 4D0, 0D0, 0D0, : 10D0, 0D0, 0D0, -6D0, 0D0, 0D0, : -21D0, 0D0, 0D0, 9D0, 0D0, 0D0, : -15D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -5D0, 0D0, 0D0, : -29D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -19D0, 0D0, 0D0, 10D0, 0D0, 0D0, : 12D0, 0D0, 0D0, -5D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=381,390 ) / : 22D0, 0D0, 0D0, -9D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 5D0, 0D0, 0D0, : -20D0, 0D0, 0D0, 11D0, 0D0, 0D0, : -20D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -17D0, 0D0, 0D0, 7D0, 0D0, 0D0, : 15D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 8D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 14D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 6D0, 0D0, 0D0, : 25D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=391,400 ) / : -13D0, 0D0, 0D0, 6D0, 0D0, 0D0, : -14D0, 0D0, 0D0, 8D0, 0D0, 0D0, : 13D0, 0D0, 0D0, -5D0, 0D0, 0D0, : -17D0, 0D0, 0D0, 9D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 6D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 5D0, 0D0, 0D0, : 10D0, 0D0, 0D0, -6D0, 0D0, 0D0, : -15D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -22D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 28D0, 0D0, 0D0, -1D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=401,410 ) / : 15D0, 0D0, 0D0, -7D0, 0D0, 0D0, : 23D0, 0D0, 0D0, -10D0, 0D0, 0D0, : 12D0, 0D0, 0D0, -5D0, 0D0, 0D0, : 29D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -25D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 22D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -18D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 15D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -23D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 12D0, 0D0, 0D0, -5D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=411,420 ) / : -8D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -19D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 4D0, 0D0, 0D0, : 21D0, 0D0, 0D0, -9D0, 0D0, 0D0, : 23D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -16D0, 0D0, 0D0, 8D0, 0D0, 0D0, : -19D0, 0D0, 0D0, 9D0, 0D0, 0D0, : -22D0, 0D0, 0D0, 10D0, 0D0, 0D0, : 27D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 16D0, 0D0, 0D0, -8D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=421,430 ) / : 19D0, 0D0, 0D0, -8D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -4D0, 0D0, 0D0, : -9D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -9D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -8D0, 0D0, 0D0, 4D0, 0D0, 0D0, : 18D0, 0D0, 0D0, -9D0, 0D0, 0D0, : 16D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -10D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -23D0, 0D0, 0D0, 9D0, 0D0, 0D0, : 16D0, 0D0, 0D0, -1D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=431,440 ) / : -12D0, 0D0, 0D0, 6D0, 0D0, 0D0, : -8D0, 0D0, 0D0, 4D0, 0D0, 0D0, : 30D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 24D0, 0D0, 0D0, -10D0, 0D0, 0D0, : 10D0, 0D0, 0D0, -4D0, 0D0, 0D0, : -16D0, 0D0, 0D0, 7D0, 0D0, 0D0, : -16D0, 0D0, 0D0, 7D0, 0D0, 0D0, : 17D0, 0D0, 0D0, -7D0, 0D0, 0D0, : -24D0, 0D0, 0D0, 10D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 5D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=441,450 ) / : -24D0, 0D0, 0D0, 11D0, 0D0, 0D0, : -23D0, 0D0, 0D0, 9D0, 0D0, 0D0, : -13D0, 0D0, 0D0, 5D0, 0D0, 0D0, : -15D0, 0D0, 0D0, 7D0, 0D0, 0D0, : 0D0, 0D0, -1988D0, 0D0, 0D0, -1679D0, : 0D0, 0D0, -63D0, 0D0, 0D0, -27D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 0D0, 0D0, 5D0, 0D0, 0D0, 4D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 0D0, 0D0, 364D0, 0D0, 0D0, 176D0 / DATA ( ( CLS(I,J), I=1,6 ), J=451,460 ) / : 0D0, 0D0, -1044D0, 0D0, 0D0, -891D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 0D0, 0D0, 330D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=461,470 ) / : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 0D0, 0D0, 5D0, 0D0, 0D0, 0D0, : 0D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 6D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=471,480 ) / : -5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 7D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 0D0, 0D0, -12D0, 0D0, 0D0, -10D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=481,490 ) / : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 7D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=491,500 ) / : -8D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 9D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=501,510 ) / : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 9D0, 0D0, 0D0, -3D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=511,520 ) / : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 8D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=521,530 ) / : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 9D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -13D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=531,540 ) / : 10D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 10D0, 0D0, 13D0, 6D0, 0D0, -5D0, : 0D0, 0D0, 30D0, 0D0, 0D0, 14D0, : 0D0, 0D0, -162D0, 0D0, 0D0, -138D0, : 0D0, 0D0, 75D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=541,550 ) / : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 6D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 9D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=551,560 ) / : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -6D0, 0D0, -3D0, 3D0, 0D0, 1D0, : 0D0, 0D0, -3D0, 0D0, 0D0, -2D0, : 11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=561,570 ) / : -1D0, 0D0, 3D0, 3D0, 0D0, -1D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 0D0, 0D0, -13D0, 0D0, 0D0, -11D0, : 3D0, 0D0, 6D0, 0D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 3D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=571,580 ) / : 8D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 8D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=581,590 ) / : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -8D0, 0D0, 0D0, 4D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 6D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=591,600 ) / : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 0D0, 0D0, -26D0, 0D0, 0D0, -11D0, : 0D0, 0D0, -10D0, 0D0, 0D0, -5D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -13D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=601,610 ) / : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 7D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -7D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=611,620 ) / : 13D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=621,630 ) / : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -12D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : 0D0, 0D0, -5D0, 0D0, 0D0, -2D0, : -7D0, 0D0, 0D0, 4D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=631,640 ) / : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : 3D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 12D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=641,650 ) / : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 6D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 6D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 6D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=651,660 ) / : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 7D0, 0D0, 0D0, -4D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -5D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 5D0, 0D0, 0D0, 0D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 3D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 10D0, 0D0, 0D0, 0D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=661,670 ) / : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 7D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 7D0, 0D0, 0D0, -3D0, 0D0, 0D0, : 4D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 11D0, 0D0, 0D0, 0D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0, : -6D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 5D0, 0D0, 0D0, -2D0, 0D0, 0D0 / DATA ( ( CLS(I,J), I=1,6 ), J=671,678 ) / : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -4D0, 0D0, 0D0, 2D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0, : 4D0, 0D0, 0D0, -2D0, 0D0, 0D0, : 3D0, 0D0, 0D0, -1D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 1D0, 0D0, 0D0, : -3D0, 0D0, 0D0, 2D0, 0D0, 0D0 / * * Planetary argument multipliers * : L L' F D Om Me Ve E Ma Ju Sa Ur Ne pre DATA ( ( NAPL(I,J), I=1,14 ), J= 1, 10 ) / : 0, 0, 0, 0, 0, 0, 0, 8,-16, 4, 5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -8, 16, -4, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 8,-16, 4, 5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 2, 2, : 0, 0, 0, 0, 0, 0, 0, -4, 8, -1, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -8, 3, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, 3, -8, 3, 0, 0, 0, 0, : -1, 0, 0, 0, 0, 0, 10, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, -2, 6, -3, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 11, 20 ) / : 0, 0, 1, -1, 1, 0, 0, -5, 8, -3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -4, 8, -3, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 4, -8, 1, 5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 6, 4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, -5, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 2, -5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, -5, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, -2, 5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, -2, 5, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J= 21, 30 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, -2, 5, 0, 0, 2, : 2, 0, -1, -1, 0, 0, 0, 3, -7, 0, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 19,-21, 3, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 2, -4, 0, -3, 0, 0, 0, 0, : 1, 0, 0, -1, 1, 0, 0, -1, 0, 2, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, -4, 10, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 0, 2, 0, 0, -5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -7, 4, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 1, -1, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 0, 2, 0, -2, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 31, 40 ) / : -1, 0, 0, 0, 0, 0, 18,-16, 0, 0, 0, 0, 0, 0, : -2, 0, 1, 1, 2, 0, 0, 1, 0, -2, 0, 0, 0, 0, : -1, 0, 1, -1, 1, 0, 18,-17, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 1, 1, 0, 0, 2, -2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -8, 13, 0, 0, 0, 0, 0, 2, : 0, 0, 2, -2, 2, 0, -8, 11, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -8, 13, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -8, 12, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 8,-13, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 8,-14, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 41, 50 ) / : 0, 0, 0, 0, 0, 0, 8,-13, 0, 0, 0, 0, 0, 1, : -2, 0, 0, 2, 1, 0, 0, 2, 0, -4, 5, 0, 0, 0, : -2, 0, 0, 2, 2, 0, 3, -3, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -3, 1, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 3, -5, 0, 2, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -4, 3, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -1, 2, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -2, 2, 0, 0, 0, 0, 0, : -1, 0, 1, 0, 1, 0, 3, -5, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 51, 60 ) / : -1, 0, 0, 1, 0, 0, 3, -4, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -2, -2, 0, 0, 0, : -2, 0, 2, 0, 2, 0, 0, -5, 9, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 0, -1, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 0, 0, 2, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, : -1, 0, 0, 1, 0, 0, 0, 3, -4, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 0, 2, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 61, 70 ) / : 0, 0, 1, -1, 2, 0, 0, -1, 0, 0, 2, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -9, 17, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, -3, 5, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, -1, 2, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 17,-16, 0, -2, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 1, -3, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 0, 5, -6, 0, 0, 0, 0, 0, : 0, 0, -2, 2, 0, 0, 0, 9,-13, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -1, 0, 0, 1, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 71, 80 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, : 0, 0, -2, 2, 0, 0, 5, -6, 0, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 1, 0, 5, -7, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 6, -8, 0, 0, 0, 0, 0, 0, : 2, 0, 1, -3, 1, 0, -6, 7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, 0, 0, 1, 0, 0, 0, 0, : 0, 0, -1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 0, 2, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J= 81, 90 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -8, 15, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -8, 15, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -9, 15, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 8,-15, 0, 0, 0, 0, 0, : 1, 0, -1, -1, 0, 0, 0, 8,-15, 0, 0, 0, 0, 0, : 2, 0, 0, -2, 0, 0, 2, -5, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -5, 5, 0, 0, 0, : 2, 0, 0, -2, 1, 0, 0, -6, 8, 0, 0, 0, 0, 0, : 2, 0, 0, -2, 1, 0, 0, -2, 0, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J= 91,100 ) / : -2, 0, 1, 1, 0, 0, 0, 1, 0, -3, 0, 0, 0, 0, : -2, 0, 1, 1, 1, 0, 0, 1, 0, -3, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -3, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 6, -8, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -1, -5, 0, 0, 0, : -1, 0, 0, 1, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : -1, 0, 1, 1, 1, 0,-20, 20, 0, 0, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 20,-21, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 8,-15, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0,-10, 15, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=101,110 ) / : 0, 0, -1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, -2, 4, 0, 0, 0, : 2, 0, 0, -2, 1, 0, -6, 8, 0, 0, 0, 0, 0, 0, : 0, 0, -2, 2, 1, 0, 5, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, -1, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 1, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=111,120 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, : 0, 0, 2, -2, 1, 0, 0, -9, 13, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 7,-13, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 5, -6, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 9,-17, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -9, 17, 0, 0, 0, 0, 2, : 1, 0, 0, -1, 1, 0, 0, -3, 4, 0, 0, 0, 0, 0, : 1, 0, 0, -1, 1, 0, -3, 4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, -1, 2, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=121,130 ) / : 0, 0, -1, 1, 1, 0, 0, 0, 2, 0, 0, 0, 0, 0, : 0, 0, -2, 2, 0, 1, 0, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -5, 0, 2, 0, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 0, 2, 0, -3, 1, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 8,-13, 0, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 8,-12, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, -8, 11, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 1, 0, 0, 0, 2, -2, 0, 0, 0, 0, 0, : -1, 0, 0, 0, 1, 0, 18,-16, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=131,140 ) / : 0, 0, 1, -1, 1, 0, 0, -1, 0, -1, 1, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 3, -7, 4, 0, 0, 0, 0, 0, : -2, 0, 1, 1, 1, 0, 0, -3, 7, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -1, 0, -2, 5, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 0, 0, -2, 5, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -4, 8, -3, 0, 0, 0, 0, : 1, 0, 0, 0, 1, 0,-10, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -2, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 0, 1, 0, 10, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 4, -8, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=141,150 ) / : 0, 0, 0, 0, 1, 0, 0, 0, 0, 2, -5, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 2, -5, 0, 0, 0, : 2, 0, -1, -1, 1, 0, 0, 3, -7, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, 0, -5, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -3, 7, -4, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 1, 0, 0, 0, 1, 0,-18, 16, 0, 0, 0, 0, 0, 0, : -2, 0, 1, 1, 1, 0, 0, 1, 0, -2, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, -8, 12, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -8, 13, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=151,160 ) / : 0, 0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, 0, -2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -2, 2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 2, 0, 0, 0, 0, 1, : -1, 0, 0, 1, 1, 0, 3, -4, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 1, 1, 0, 0, 3, -4, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, -2, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 2, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=161,170 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 2, : 0, 0, 1, -1, 0, 0, 3, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -3, 5, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, -3, 4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -2, 4, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, -5, 6, 0, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 5, -7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 5, -8, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 6, -8, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -8, 15, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=171,180 ) / : -2, 0, 0, 2, 1, 0, 0, 2, 0, -3, 0, 0, 0, 0, : -2, 0, 0, 2, 1, 0, 0, 6, -8, 0, 0, 0, 0, 0, : 1, 0, 0, -1, 1, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, -5, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=181,190 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 2, : 0, 0, 1, -1, 2, 0, 0, -1, 0, 0, -1, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, -1, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 0, -1, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -7, 13, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 7,-13, 0, 0, 0, 0, 0, : 2, 0, 0, -2, 1, 0, 0, -5, 6, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -8, 11, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, -1, 0, 2, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 4, -4, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=191,200 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, -2, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 0, 3, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 2, : -2, 0, 0, 2, 0, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, -4, 8, -3, 0, 0, 0, 0, : 0, 0, 0, 0, 2, 0, 0, 4, -8, 3, 0, 0, 0, 0, : 2, 0, 0, -2, 1, 0, 0, -2, 0, 2, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -1, 0, 2, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, 0, -2, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=201,210 ) / : 0, 0, 0, 0, 1, 0, 0, 1, -2, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 2, -2, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, 0, -2, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -2, 0, 0, 2, 0, 0, 0, : 0, 0, 1, -1, 1, 0, 3, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 3, -5, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 1, 0, -3, 4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -3, 5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -3, 5, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=211,220 ) / : 0, 0, 2, -2, 2, 0, -3, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -3, 5, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, -4, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, 1, -4, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, -4, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -2, 4, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -3, 4, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -2, 4, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, -2, 4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 8, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=221,230 ) / : 0, 0, 2, -2, 2, 0, -5, 6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -5, 8, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 8, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -5, 7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -5, 8, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 5, -8, 0, 0, 0, 0, 0, 0, : 0, 0, 1, -1, 2, 0, 0, -1, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 0, 0, -1, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -2, 0, 1, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=231,240 ) / : 0, 0, 0, 0, 0, 0, 0, -6, 11, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6,-11, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, -1, 0, 4, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 1, 0, -4, 0, 0, 0, 0, 0, 0, : 2, 0, 0, -2, 1, 0, -3, 3, 0, 0, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 2, 0, 0, -2, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -7, 9, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=241,250 ) / : 0, 0, 1, -1, 1, 0, 0, -1, 0, 2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 2, : 0, 0, 2, -2, 2, 0, 0, -2, 0, 2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 2, : 0, 0, 0, 0, 1, 0, 3, -5, 0, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 3, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, -3, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 2, -4, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -4, 4, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=251,260 ) / : 0, 0, 1, -1, 2, 0, -5, 7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 3, -6, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -3, 6, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -4, 6, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -3, 6, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, -3, 6, 0, 0, 0, 0, 2, : 0, 0, -1, 1, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 2, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -5, 9, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -5, 9, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=261,270 ) / : 0, 0, 0, 0, 0, 0, 0, 5, -9, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 0, 1, 0, -2, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -2, 0, 2, 0, 0, 0, 0, : -2, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, -2, 2, 0, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -6, 10, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -6, 10, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -2, 3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -2, 3, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -2, 2, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=271,280 ) / : 0, 0, 0, 0, 0, 0, 2, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, -3, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, -1, 0, 3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -8, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -4, 8, 0, 0, 0, 0, 2, : 0, 0, -2, 2, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -4, 7, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=281,290 ) / : 0, 0, 0, 0, 0, 0, 0, -4, 7, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 4, -7, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -2, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -2, 0, 3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -5, 10, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 1, 0, -1, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -3, 5, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -3, 5, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 3, -5, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=291,300 ) / : 0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 1, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -1, 2, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -1, 2, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 11, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 11, 0, 0, 0, 0, 0, 1, : 0, 0, -2, 2, 0, 0, 4, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, -3, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, -4, 4, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=301,310 ) / : 0, 0, -1, 1, 0, 0, 4, -5, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -4, 7, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -4, 6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -4, 7, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -4, 6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -4, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -4, 5, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -4, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 4, -6, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=311,320 ) / : -2, 0, 0, 2, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, : 0, 0, -1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 5, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, -3, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 3, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -7, 12, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -1, 1, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -1, 1, 0, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=321,330 ) / : 0, 0, 1, -1, 1, 0, -1, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 1, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -2, 5, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 4, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -4, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -1, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -6, 10, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -6, 10, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=331,340 ) / : 0, 0, 2, -2, 1, 0, 0, -3, 0, 3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -3, 7, 0, 0, 0, 0, 2, : -2, 0, 0, 2, 0, 0, 4, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -5, 8, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -8, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 3, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -2, 4, 0, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=341,350 ) / : 0, 0, 1, -1, 1, 0, -2, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -2, 4, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 9, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 9, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 6, -9, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 1, 0, -2, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, -2, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -4, 6, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -6, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 3, -4, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=351,360 ) / : 0, 0, 0, 0, 0, 0, 0, -1, 0, 2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -2, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -5, 9, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, -4, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -3, 4, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -3, 4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 3, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 1, 0, 0, 2, -2, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=361,370 ) / : 0, 0, 0, 0, 1, 0, 0, -1, 0, 2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -3, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, -5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -3, 5, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -3, 4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -2, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, -2, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=371,380 ) / : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, -1, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, -2, 2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -8, 14, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, -5, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 5, -8, 3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 5, -8, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 3, -8, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=381,390 ) / : 0, 0, 0, 0, 0, 0, 0, -3, 8, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, -2, 5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 12, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 12, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, -2, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 2, 0, 0, 2, : 0, 0, 2, -2, 1, 0, -5, 5, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=391,400 ) / : 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -3, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -3, 6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 7, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 7, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, -5, 6, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=401,410 ) / : 0, 0, 0, 0, 0, 0, 5, -7, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, -1, 0, 3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -2, 6, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 1, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -6, 9, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, -9, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -2, 2, 0, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=411,420 ) / : 0, 0, 1, -1, 1, 0, -2, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, -2, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 1, 0, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -5, 7, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -7, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, -2, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 4, -5, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -1, 3, 0, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=421,430 ) / : 0, 0, 1, -1, 1, 0, -1, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -1, 3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 10, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 10, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 3, -3, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -4, 8, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -4, 5, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -4, 5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 4, -5, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=431,440 ) / : 0, 0, 0, 0, 0, 0, 0, -2, 0, 5, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -9, 13, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 5, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -2, 0, 4, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -4, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -2, 7, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=441,450 ) / : 0, 0, 0, 0, 0, 0, -2, 5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -2, 5, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 8, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 8, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 6, -8, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 1, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, -3, 9, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -6, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 5, -6, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=451,460 ) / : 0, 0, 0, 0, 0, 0, 0, 2, 0, -2, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 10, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -4, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 4, -4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -3, 3, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -3, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 3, -3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, -3, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=461,470 ) / : 0, 0, 0, 0, 0, 0, 0, -5, 13, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, -2, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, -2, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 3, -2, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 3, -2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, -1, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -6, 15, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 15, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=471,480 ) / : 0, 0, 0, 0, 0, 0, -3, 9, -4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 2, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -2, 8, -1, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, -8, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1, : 0, 0, 1, -1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=481,490 ) / : 0, 0, 0, 0, 0, 0, 0, -6, 16, -4, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -2, 8, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -2, 8, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, -8, 1, 5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -2, 5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, -5, 4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 11, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 11, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -8, 11, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 11, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=491,500 ) / : 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 1, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, -3, 0, 2, 0, 0, 0, 2, : 0, 0, 2, -2, 1, 0, 0, 4, -8, 3, 0, 0, 0, 0, : 0, 0, 1, -1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 0, -4, 8, -3, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -3, 7, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 6, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=501,510 ) / : 0, 0, 0, 0, 0, 0, -5, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 5, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 5, -6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 0, 2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 6, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 7, -9, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 2, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, -1, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, -7, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -5, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=511,520 ) / : 0, 0, 0, 0, 0, 0, -1, 4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -1, 4, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 9, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -7, 9, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 4, -3, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, -1, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -4, 4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 4, -4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 4, -4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 4, -4, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=521,530 ) / : 0, 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -3, 0, 5, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -9, 12, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, -4, 0, 0, 0, 0, : 0, 0, 2, -2, 1, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 7, -8, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, -3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=531,540 ) / : 0, 0, 0, 0, 0, 0, 0, 3, 0, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -2, 6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 7, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 6, -7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 6, -6, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, -2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 3, 0, -2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -2, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=541,550 ) / : 0, 0, 0, 0, 0, 0, 0, 3, 0, -1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, -1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, -2, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, -2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, -1, 0, 0, 2, : 0, 0, 2, -2, 1, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, -8, 16, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, 2, -5, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 7, -8, 3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -5, 16, -4, -5, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=551,560 ) / : 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, -1, 8, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 10, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 10, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -8, 10, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 3, 0, 1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -3, 8, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -5, 5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 5, -5, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=561,570 ) / : 0, 0, 0, 0, 0, 0, 5, -5, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 5, -5, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 7, -7, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 7, -7, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, -5, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 7, -8, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 5, -3, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=571,580 ) / : 0, 0, 0, 0, 0, 0, 4, -3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 1, 2, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -9, 11, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -9, 11, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 4, 0, -4, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, 0, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -6, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 6, -6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 6, -6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 4, 0, -2, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=581,590 ) / : 0, 0, 0, 0, 0, 0, 0, 6, -4, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 3, -1, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 3, -1, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, 0, -1, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, -2, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, -2, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 8, -9, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 5, -4, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=591,600 ) / : 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 2, 1, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -7, 7, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 7, -7, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 4, -2, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 4, -2, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 4, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 4, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 5, 0, -4, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=601,610 ) / : 0, 0, 0, 0, 0, 0, 0, 5, 0, -3, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 5, 0, -2, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -8, 8, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 8, -8, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 5, -3, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 5, -3, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, -9, 9, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -9, 9, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, -9, 9, 0, 0, 0, 0, 0, 1 / DATA ( ( NAPL(I,J), I=1,14 ), J=611,620 ) / : 0, 0, 0, 0, 0, 0, 9, -9, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 6, -4, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 2, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 1, : 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 2 / DATA ( ( NAPL(I,J), I=1,14 ), J=621,630 ) / : 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, : 1, 0, 0, -2, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 1, -1, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 0, 0, 0, 3, -3, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 0, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : -1, 0, 0, 2, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0, : 1, 0, 0, -2, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0, : -2, 0, 0, 2, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=631,640 ) / : -1, 0, 0, 0, 0, 0, 0, 2, 0, -3, 0, 0, 0, 0, : -1, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : -1, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 2, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 1, 0, -1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, : -1, 0, 0, 2, 0, 0, 0, 2, 0, -3, 0, 0, 0, 0, : -2, 0, 0, 0, 0, 0, 0, 2, 0, -3, 0, 0, 0, 0, : 1, 0, 0, 0, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0, : -1, 0, 1, -1, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0, : 1, 0, 1, -1, 1, 0, 0, -1, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=641,650 ) / : -1, 0, 0, 0, 0, 0, 0, 4, -8, 3, 0, 0, 0, 0, : -1, 0, 0, 2, 1, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 0, 0, 0, 0, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : -1, 0, 0, 2, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : -1, 0, 0, 2, 0, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 1, 0, 0, -2, 1, 0, 0, -2, 0, 2, 0, 0, 0, 0, : 1, 0, 2, -2, 2, 0, -3, 3, 0, 0, 0, 0, 0, 0, : 1, 0, 2, -2, 2, 0, 0, -2, 0, 2, 0, 0, 0, 0, : 1, 0, 0, 0, 0, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 1, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=651,660 ) / : 0, 0, 0, -2, 0, 0, 2, -2, 0, 0, 0, 0, 0, 0, : 0, 0, 0, -2, 0, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, -2, 2, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, -1, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, -2, 3, 0, 0, 0, 0, 0, 0, : 0, 0, 0, 2, 0, 0, 0, 2, 0, -2, 0, 0, 0, 0, : 0, 0, 1, 1, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, : -1, 0, 2, 0, 2, 0, 10, -3, 0, 0, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=661,670 ) / : 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 4, -8, 3, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, -4, 8, -3, 0, 0, 0, 0, : -1, 0, 2, 0, 2, 0, 0, -4, 8, -3, 0, 0, 0, 0, : 2, 0, 2, -2, 2, 0, 0, -2, 0, 3, 0, 0, 0, 0, : 1, 0, 2, 0, 1, 0, 0, -2, 0, 3, 0, 0, 0, 0, : 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, : -1, 0, 2, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : -2, 0, 2, 2, 2, 0, 0, 2, 0, -2, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=671,680 ) / : 0, 0, 2, 0, 2, 0, 2, -3, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 1, 0, -1, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 2, -2, 0, 0, 0, 0, 0, 0, : -1, 0, 2, 2, 2, 0, 0, -1, 0, 1, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, -1, 1, 0, 0, 0, 0, 0, 0, : -1, 0, 2, 2, 2, 0, 0, 2, 0, -3, 0, 0, 0, 0, : 2, 0, 2, 0, 2, 0, 0, 2, 0, -3, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 0, -4, 8, -3, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 0, 4, -8, 3, 0, 0, 0, 0 / DATA ( ( NAPL(I,J), I=1,14 ), J=681,687 ) / : 1, 0, 1, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 0, 2, 0, 0, 1, 0, 0, 0, 0, 0, 0, : 2, 0, 2, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, : -1, 0, 2, 2, 2, 0, 0, 2, 0, -2, 0, 0, 0, 0, : -1, 0, 2, 2, 2, 0, 3, -3, 0, 0, 0, 0, 0, 0, : 1, 0, 2, 0, 2, 0, 1, -1, 0, 0, 0, 0, 0, 0, : 0, 0, 2, 2, 2, 0, 0, 2, 0, -2, 0, 0, 0, 0 / * * Planetary nutation coefficients, unit 1e-7 arcsec * longitude (sin, cos), obliquity (sin, cos) * DATA ( ( ICPL(I,J), I=1,4 ), J= 1, 10 ) / : 1440, 0, 0, 0, : 56, -117, -42, -40, : 125, -43, 0, -54, : 0, 5, 0, 0, : 3, -7, -3, 0, : 3, 0, 0, -2, : -114, 0, 0, 61, : -219, 89, 0, 0, : -3, 0, 0, 0, : -462, 1604, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J= 11, 20 ) / : 99, 0, 0, -53, : -3, 0, 0, 2, : 0, 6, 2, 0, : 3, 0, 0, 0, : -12, 0, 0, 0, : 14, -218, 117, 8, : 31, -481, -257, -17, : -491, 128, 0, 0, : -3084, 5123, 2735, 1647, : -1444, 2409, -1286, -771 / DATA ( ( ICPL(I,J), I=1,4 ), J= 21, 30 ) / : 11, -24, -11, -9, : 26, -9, 0, 0, : 103, -60, 0, 0, : 0, -13, -7, 0, : -26, -29, -16, 14, : 9, -27, -14, -5, : 12, 0, 0, -6, : -7, 0, 0, 0, : 0, 24, 0, 0, : 284, 0, 0, -151 / DATA ( ( ICPL(I,J), I=1,4 ), J= 31, 40 ) / : 226, 101, 0, 0, : 0, -8, -2, 0, : 0, -6, -3, 0, : 5, 0, 0, -3, : -41, 175, 76, 17, : 0, 15, 6, 0, : 425, 212, -133, 269, : 1200, 598, 319, -641, : 235, 334, 0, 0, : 11, -12, -7, -6 / DATA ( ( ICPL(I,J), I=1,4 ), J= 41, 50 ) / : 5, -6, 3, 3, : -5, 0, 0, 3, : 6, 0, 0, -3, : 15, 0, 0, 0, : 13, 0, 0, -7, : -6, -9, 0, 0, : 266, -78, 0, 0, : -460, -435, -232, 246, : 0, 15, 7, 0, : -3, 0, 0, 2 / DATA ( ( ICPL(I,J), I=1,4 ), J= 51, 60 ) / : 0, 131, 0, 0, : 4, 0, 0, 0, : 0, 3, 0, 0, : 0, 4, 2, 0, : 0, 3, 0, 0, : -17, -19, -10, 9, : -9, -11, 6, -5, : -6, 0, 0, 3, : -16, 8, 0, 0, : 0, 3, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J= 61, 70 ) / : 11, 24, 11, -5, : -3, -4, -2, 1, : 3, 0, 0, -1, : 0, -8, -4, 0, : 0, 3, 0, 0, : 0, 5, 0, 0, : 0, 3, 2, 0, : -6, 4, 2, 3, : -3, -5, 0, 0, : -5, 0, 0, 2 / DATA ( ( ICPL(I,J), I=1,4 ), J= 71, 80 ) / : 4, 24, 13, -2, : -42, 20, 0, 0, : -10, 233, 0, 0, : -3, 0, 0, 1, : 78, -18, 0, 0, : 0, 3, 1, 0, : 0, -3, -1, 0, : 0, -4, -2, 1, : 0, -8, -4, -1, : 0, -5, 3, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J= 81, 90 ) / : -7, 0, 0, 3, : -14, 8, 3, 6, : 0, 8, -4, 0, : 0, 19, 10, 0, : 45, -22, 0, 0, : -3, 0, 0, 0, : 0, -3, 0, 0, : 0, 3, 0, 0, : 3, 5, 3, -2, : 89, -16, -9, -48 / DATA ( ( ICPL(I,J), I=1,4 ), J= 91,100 ) / : 0, 3, 0, 0, : -3, 7, 4, 2, : -349, -62, 0, 0, : -15, 22, 0, 0, : -3, 0, 0, 0, : -53, 0, 0, 0, : 5, 0, 0, -3, : 0, -8, 0, 0, : 15, -7, -4, -8, : -3, 0, 0, 1 / DATA ( ( ICPL(I,J), I=1,4 ), J=101,110 ) / : -21, -78, 0, 0, : 20, -70, -37, -11, : 0, 6, 3, 0, : 5, 3, 2, -2, : -17, -4, -2, 9, : 0, 6, 3, 0, : 32, 15, -8, 17, : 174, 84, 45, -93, : 11, 56, 0, 0, : -66, -12, -6, 35 / DATA ( ( ICPL(I,J), I=1,4 ), J=111,120 ) / : 47, 8, 4, -25, : 0, 8, 4, 0, : 10, -22, -12, -5, : -3, 0, 0, 2, : -24, 12, 0, 0, : 5, -6, 0, 0, : 3, 0, 0, -2, : 4, 3, 1, -2, : 0, 29, 15, 0, : -5, -4, -2, 2 / DATA ( ( ICPL(I,J), I=1,4 ), J=121,130 ) / : 8, -3, -1, -5, : 0, -3, 0, 0, : 10, 0, 0, 0, : 3, 0, 0, -2, : -5, 0, 0, 3, : 46, 66, 35, -25, : -14, 7, 0, 0, : 0, 3, 2, 0, : -5, 0, 0, 0, : -68, -34, -18, 36 / DATA ( ( ICPL(I,J), I=1,4 ), J=131,140 ) / : 0, 14, 7, 0, : 10, -6, -3, -5, : -5, -4, -2, 3, : -3, 5, 2, 1, : 76, 17, 9, -41, : 84, 298, 159, -45, : 3, 0, 0, -1, : -3, 0, 0, 2, : -3, 0, 0, 1, : -82, 292, 156, 44 / DATA ( ( ICPL(I,J), I=1,4 ), J=141,150 ) / : -73, 17, 9, 39, : -9, -16, 0, 0, : 3, 0, -1, -2, : -3, 0, 0, 0, : -9, -5, -3, 5, : -439, 0, 0, 0, : 57, -28, -15, -30, : 0, -6, -3, 0, : -4, 0, 0, 2, : -40, 57, 30, 21 / DATA ( ( ICPL(I,J), I=1,4 ), J=151,160 ) / : 23, 7, 3, -13, : 273, 80, 43, -146, : -449, 430, 0, 0, : -8, -47, -25, 4, : 6, 47, 25, -3, : 0, 23, 13, 0, : -3, 0, 0, 2, : 3, -4, -2, -2, : -48, -110, -59, 26, : 51, 114, 61, -27 / DATA ( ( ICPL(I,J), I=1,4 ), J=161,170 ) / : -133, 0, 0, 57, : 0, 4, 0, 0, : -21, -6, -3, 11, : 0, -3, -1, 0, : -11, -21, -11, 6, : -18, -436, -233, 9, : 35, -7, 0, 0, : 0, 5, 3, 0, : 11, -3, -1, -6, : -5, -3, -1, 3 / DATA ( ( ICPL(I,J), I=1,4 ), J=171,180 ) / : -53, -9, -5, 28, : 0, 3, 2, 1, : 4, 0, 0, -2, : 0, -4, 0, 0, : -50, 194, 103, 27, : -13, 52, 28, 7, : -91, 248, 0, 0, : 6, 49, 26, -3, : -6, -47, -25, 3, : 0, 5, 3, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=181,190 ) / : 52, 23, 10, -23, : -3, 0, 0, 1, : 0, 5, 3, 0, : -4, 0, 0, 0, : -4, 8, 3, 2, : 10, 0, 0, 0, : 3, 0, 0, -2, : 0, 8, 4, 0, : 0, 8, 4, 1, : -4, 0, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=191,200 ) / : -4, 0, 0, 0, : -8, 4, 2, 4, : 8, -4, -2, -4, : 0, 15, 7, 0, : -138, 0, 0, 0, : 0, -7, -3, 0, : 0, -7, -3, 0, : 54, 0, 0, -29, : 0, 10, 4, 0, : -7, 0, 0, 3 / DATA ( ( ICPL(I,J), I=1,4 ), J=201,210 ) / : -37, 35, 19, 20, : 0, 4, 0, 0, : -4, 9, 0, 0, : 8, 0, 0, -4, : -9, -14, -8, 5, : -3, -9, -5, 3, : -145, 47, 0, 0, : -10, 40, 21, 5, : 11, -49, -26, -7, : -2150, 0, 0, 932 / DATA ( ( ICPL(I,J), I=1,4 ), J=211,220 ) / : -12, 0, 0, 5, : 85, 0, 0, -37, : 4, 0, 0, -2, : 3, 0, 0, -2, : -86, 153, 0, 0, : -6, 9, 5, 3, : 9, -13, -7, -5, : -8, 12, 6, 4, : -51, 0, 0, 22, : -11, -268, -116, 5 / DATA ( ( ICPL(I,J), I=1,4 ), J=221,230 ) / : 0, 12, 5, 0, : 0, 7, 3, 0, : 31, 6, 3, -17, : 140, 27, 14, -75, : 57, 11, 6, -30, : -14, -39, 0, 0, : 0, -6, -2, 0, : 4, 15, 8, -2, : 0, 4, 0, 0, : -3, 0, 0, 1 / DATA ( ( ICPL(I,J), I=1,4 ), J=231,240 ) / : 0, 11, 5, 0, : 9, 6, 0, 0, : -4, 10, 4, 2, : 5, 3, 0, 0, : 16, 0, 0, -9, : -3, 0, 0, 0, : 0, 3, 2, -1, : 7, 0, 0, -3, : -25, 22, 0, 0, : 42, 223, 119, -22 / DATA ( ( ICPL(I,J), I=1,4 ), J=241,250 ) / : -27, -143, -77, 14, : 9, 49, 26, -5, : -1166, 0, 0, 505, : -5, 0, 0, 2, : -6, 0, 0, 3, : -8, 0, 1, 4, : 0, -4, 0, 0, : 117, 0, 0, -63, : -4, 8, 4, 2, : 3, 0, 0, -2 / DATA ( ( ICPL(I,J), I=1,4 ), J=251,260 ) / : -5, 0, 0, 2, : 0, 31, 0, 0, : -5, 0, 1, 3, : 4, 0, 0, -2, : -4, 0, 0, 2, : -24, -13, -6, 10, : 3, 0, 0, 0, : 0, -32, -17, 0, : 8, 12, 5, -3, : 3, 0, 0, -1 / DATA ( ( ICPL(I,J), I=1,4 ), J=261,270 ) / : 7, 13, 0, 0, : -3, 16, 0, 0, : 50, 0, 0, -27, : 0, -5, -3, 0, : 13, 0, 0, 0, : 0, 5, 3, 1, : 24, 5, 2, -11, : 5, -11, -5, -2, : 30, -3, -2, -16, : 18, 0, 0, -9 / DATA ( ( ICPL(I,J), I=1,4 ), J=271,280 ) / : 8, 614, 0, 0, : 3, -3, -1, -2, : 6, 17, 9, -3, : -3, -9, -5, 2, : 0, 6, 3, -1, : -127, 21, 9, 55, : 3, 5, 0, 0, : -6, -10, -4, 3, : 5, 0, 0, 0, : 16, 9, 4, -7 / DATA ( ( ICPL(I,J), I=1,4 ), J=281,290 ) / : 3, 0, 0, -2, : 0, 22, 0, 0, : 0, 19, 10, 0, : 7, 0, 0, -4, : 0, -5, -2, 0, : 0, 3, 1, 0, : -9, 3, 1, 4, : 17, 0, 0, -7, : 0, -3, -2, -1, : -20, 34, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=291,300 ) / : -10, 0, 1, 5, : -4, 0, 0, 2, : 22, -87, 0, 0, : -4, 0, 0, 2, : -3, -6, -2, 1, : -16, -3, -1, 7, : 0, -3, -2, 0, : 4, 0, 0, 0, : -68, 39, 0, 0, : 27, 0, 0, -14 / DATA ( ( ICPL(I,J), I=1,4 ), J=301,310 ) / : 0, -4, 0, 0, : -25, 0, 0, 0, : -12, -3, -2, 6, : 3, 0, 0, -1, : 3, 66, 29, -1, : 490, 0, 0, -213, : -22, 93, 49, 12, : -7, 28, 15, 4, : -3, 13, 7, 2, : -46, 14, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=311,320 ) / : -5, 0, 0, 0, : 2, 1, 0, 0, : 0, -3, 0, 0, : -28, 0, 0, 15, : 5, 0, 0, -2, : 0, 3, 0, 0, : -11, 0, 0, 5, : 0, 3, 1, 0, : -3, 0, 0, 1, : 25, 106, 57, -13 / DATA ( ( ICPL(I,J), I=1,4 ), J=321,330 ) / : 5, 21, 11, -3, : 1485, 0, 0, 0, : -7, -32, -17, 4, : 0, 5, 3, 0, : -6, -3, -2, 3, : 30, -6, -2, -13, : -4, 4, 0, 0, : -19, 0, 0, 10, : 0, 4, 2, -1, : 0, 3, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=331,340 ) / : 4, 0, 0, -2, : 0, -3, -1, 0, : -3, 0, 0, 0, : 5, 3, 1, -2, : 0, 11, 0, 0, : 118, 0, 0, -52, : 0, -5, -3, 0, : -28, 36, 0, 0, : 5, -5, 0, 0, : 14, -59, -31, -8 / DATA ( ( ICPL(I,J), I=1,4 ), J=341,350 ) / : 0, 9, 5, 1, : -458, 0, 0, 198, : 0, -45, -20, 0, : 9, 0, 0, -5, : 0, -3, 0, 0, : 0, -4, -2, -1, : 11, 0, 0, -6, : 6, 0, 0, -2, : -16, 23, 0, 0, : 0, -4, -2, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=351,360 ) / : -5, 0, 0, 2, : -166, 269, 0, 0, : 15, 0, 0, -8, : 10, 0, 0, -4, : -78, 45, 0, 0, : 0, -5, -2, 0, : 7, 0, 0, -4, : -5, 328, 0, 0, : 3, 0, 0, -2, : 5, 0, 0, -2 / DATA ( ( ICPL(I,J), I=1,4 ), J=361,370 ) / : 0, 3, 1, 0, : -3, 0, 0, 0, : -3, 0, 0, 0, : 0, -4, -2, 0, : -1223, -26, 0, 0, : 0, 7, 3, 0, : 3, 0, 0, 0, : 0, 3, 2, 0, : -6, 20, 0, 0, : -368, 0, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=371,380 ) / : -75, 0, 0, 0, : 11, 0, 0, -6, : 3, 0, 0, -2, : -3, 0, 0, 1, : -13, -30, 0, 0, : 21, 3, 0, 0, : -3, 0, 0, 1, : -4, 0, 0, 2, : 8, -27, 0, 0, : -19, -11, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=381,390 ) / : -4, 0, 0, 2, : 0, 5, 2, 0, : -6, 0, 0, 2, : -8, 0, 0, 0, : -1, 0, 0, 0, : -14, 0, 0, 6, : 6, 0, 0, 0, : -74, 0, 0, 32, : 0, -3, -1, 0, : 4, 0, 0, -2 / DATA ( ( ICPL(I,J), I=1,4 ), J=391,400 ) / : 8, 11, 0, 0, : 0, 3, 2, 0, : -262, 0, 0, 114, : 0, -4, 0, 0, : -7, 0, 0, 4, : 0, -27, -12, 0, : -19, -8, -4, 8, : 202, 0, 0, -87, : -8, 35, 19, 5, : 0, 4, 2, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=401,410 ) / : 16, -5, 0, 0, : 5, 0, 0, -3, : 0, -3, 0, 0, : 1, 0, 0, 0, : -35, -48, -21, 15, : -3, -5, -2, 1, : 6, 0, 0, -3, : 3, 0, 0, -1, : 0, -5, 0, 0, : 12, 55, 29, -6 / DATA ( ( ICPL(I,J), I=1,4 ), J=411,420 ) / : 0, 5, 3, 0, : -598, 0, 0, 0, : -3, -13, -7, 1, : -5, -7, -3, 2, : 3, 0, 0, -1, : 5, -7, 0, 0, : 4, 0, 0, -2, : 16, -6, 0, 0, : 8, -3, 0, 0, : 8, -31, -16, -4 / DATA ( ( ICPL(I,J), I=1,4 ), J=421,430 ) / : 0, 3, 1, 0, : 113, 0, 0, -49, : 0, -24, -10, 0, : 4, 0, 0, -2, : 27, 0, 0, 0, : -3, 0, 0, 1, : 0, -4, -2, 0, : 5, 0, 0, -2, : 0, -3, 0, 0, : -13, 0, 0, 6 / DATA ( ( ICPL(I,J), I=1,4 ), J=431,440 ) / : 5, 0, 0, -2, : -18, -10, -4, 8, : -4, -28, 0, 0, : -5, 6, 3, 2, : -3, 0, 0, 1, : -5, -9, -4, 2, : 17, 0, 0, -7, : 11, 4, 0, 0, : 0, -6, -2, 0, : 83, 15, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=441,450 ) / : -4, 0, 0, 2, : 0, -114, -49, 0, : 117, 0, 0, -51, : -5, 19, 10, 2, : -3, 0, 0, 0, : -3, 0, 0, 2, : 0, -3, -1, 0, : 3, 0, 0, 0, : 0, -6, -2, 0, : 393, 3, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=451,460 ) / : -4, 21, 11, 2, : -6, 0, -1, 3, : -3, 8, 4, 1, : 8, 0, 0, 0, : 18, -29, -13, -8, : 8, 34, 18, -4, : 89, 0, 0, 0, : 3, 12, 6, -1, : 54, -15, -7, -24, : 0, 3, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=461,470 ) / : 3, 0, 0, -1, : 0, 35, 0, 0, : -154, -30, -13, 67, : 15, 0, 0, 0, : 0, 4, 2, 0, : 0, 9, 0, 0, : 80, -71, -31, -35, : 0, -20, -9, 0, : 11, 5, 2, -5, : 61, -96, -42, -27 / DATA ( ( ICPL(I,J), I=1,4 ), J=471,480 ) / : 14, 9, 4, -6, : -11, -6, -3, 5, : 0, -3, -1, 0, : 123, -415, -180, -53, : 0, 0, 0, -35, : -5, 0, 0, 0, : 7, -32, -17, -4, : 0, -9, -5, 0, : 0, -4, 2, 0, : -89, 0, 0, 38 / DATA ( ( ICPL(I,J), I=1,4 ), J=481,490 ) / : 0, -86, -19, -6, : 0, 0, -19, 6, : -123, -416, -180, 53, : 0, -3, -1, 0, : 12, -6, -3, -5, : -13, 9, 4, 6, : 0, -15, -7, 0, : 3, 0, 0, -1, : -62, -97, -42, 27, : -11, 5, 2, 5 / DATA ( ( ICPL(I,J), I=1,4 ), J=491,500 ) / : 0, -19, -8, 0, : -3, 0, 0, 1, : 0, 4, 2, 0, : 0, 3, 0, 0, : 0, 4, 2, 0, : -85, -70, -31, 37, : 163, -12, -5, -72, : -63, -16, -7, 28, : -21, -32, -14, 9, : 0, -3, -1, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=501,510 ) / : 3, 0, 0, -2, : 0, 8, 0, 0, : 3, 10, 4, -1, : 3, 0, 0, -1, : 0, -7, -3, 0, : 0, -4, -2, 0, : 6, 19, 0, 0, : 5, -173, -75, -2, : 0, -7, -3, 0, : 7, -12, -5, -3 / DATA ( ( ICPL(I,J), I=1,4 ), J=511,520 ) / : -3, 0, 0, 2, : 3, -4, -2, -1, : 74, 0, 0, -32, : -3, 12, 6, 2, : 26, -14, -6, -11, : 19, 0, 0, -8, : 6, 24, 13, -3, : 83, 0, 0, 0, : 0, -10, -5, 0, : 11, -3, -1, -5 / DATA ( ( ICPL(I,J), I=1,4 ), J=521,530 ) / : 3, 0, 1, -1, : 3, 0, 0, -1, : -4, 0, 0, 0, : 5, -23, -12, -3, : -339, 0, 0, 147, : 0, -10, -5, 0, : 5, 0, 0, 0, : 3, 0, 0, -1, : 0, -4, -2, 0, : 18, -3, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=531,540 ) / : 9, -11, -5, -4, : -8, 0, 0, 4, : 3, 0, 0, -1, : 0, 9, 0, 0, : 6, -9, -4, -2, : -4, -12, 0, 0, : 67, -91, -39, -29, : 30, -18, -8, -13, : 0, 0, 0, 0, : 0, -114, -50, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=541,550 ) / : 0, 0, 0, 23, : 517, 16, 7, -224, : 0, -7, -3, 0, : 143, -3, -1, -62, : 29, 0, 0, -13, : -4, 0, 0, 2, : -6, 0, 0, 3, : 5, 12, 5, -2, : -25, 0, 0, 11, : -3, 0, 0, 1 / DATA ( ( ICPL(I,J), I=1,4 ), J=551,560 ) / : 0, 4, 2, 0, : -22, 12, 5, 10, : 50, 0, 0, -22, : 0, 7, 4, 0, : 0, 3, 1, 0, : -4, 4, 2, 2, : -5, -11, -5, 2, : 0, 4, 2, 0, : 4, 17, 9, -2, : 59, 0, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=561,570 ) / : 0, -4, -2, 0, : -8, 0, 0, 4, : -3, 0, 0, 0, : 4, -15, -8, -2, : 370, -8, 0, -160, : 0, 0, -3, 0, : 0, 3, 1, 0, : -6, 3, 1, 3, : 0, 6, 0, 0, : -10, 0, 0, 4 / DATA ( ( ICPL(I,J), I=1,4 ), J=571,580 ) / : 0, 9, 4, 0, : 4, 17, 7, -2, : 34, 0, 0, -15, : 0, 5, 3, 0, : -5, 0, 0, 2, : -37, -7, -3, 16, : 3, 13, 7, -2, : 40, 0, 0, 0, : 0, -3, -2, 0, : -184, -3, -1, 80 / DATA ( ( ICPL(I,J), I=1,4 ), J=581,590 ) / : -3, 0, 0, 1, : -3, 0, 0, 0, : 0, -10, -6, -1, : 31, -6, 0, -13, : -3, -32, -14, 1, : -7, 0, 0, 3, : 0, -8, -4, 0, : 3, -4, 0, 0, : 0, 4, 0, 0, : 0, 3, 1, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=591,600 ) / : 19, -23, -10, 2, : 0, 0, 0, -10, : 0, 3, 2, 0, : 0, 9, 5, -1, : 28, 0, 0, 0, : 0, -7, -4, 0, : 8, -4, 0, -4, : 0, 0, -2, 0, : 0, 3, 0, 0, : -3, 0, 0, 1 / DATA ( ( ICPL(I,J), I=1,4 ), J=601,610 ) / : -9, 0, 1, 4, : 3, 12, 5, -1, : 17, -3, -1, 0, : 0, 7, 4, 0, : 19, 0, 0, 0, : 0, -5, -3, 0, : 14, -3, 0, -1, : 0, 0, -1, 0, : 0, 0, 0, -5, : 0, 5, 3, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=611,620 ) / : 13, 0, 0, 0, : 0, -3, -2, 0, : 2, 9, 4, 3, : 0, 0, 0, -4, : 8, 0, 0, 0, : 0, 4, 2, 0, : 6, 0, 0, -3, : 6, 0, 0, 0, : 0, 3, 1, 0, : 5, 0, 0, -2 / DATA ( ( ICPL(I,J), I=1,4 ), J=621,630 ) / : 3, 0, 0, -1, : -3, 0, 0, 0, : 6, 0, 0, 0, : 7, 0, 0, 0, : -4, 0, 0, 0, : 4, 0, 0, 0, : 6, 0, 0, 0, : 0, -4, 0, 0, : 0, -4, 0, 0, : 5, 0, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=631,640 ) / : -3, 0, 0, 0, : 4, 0, 0, 0, : -5, 0, 0, 0, : 4, 0, 0, 0, : 0, 3, 0, 0, : 13, 0, 0, 0, : 21, 11, 0, 0, : 0, -5, 0, 0, : 0, -5, -2, 0, : 0, 5, 3, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=641,650 ) / : 0, -5, 0, 0, : -3, 0, 0, 2, : 20, 10, 0, 0, : -34, 0, 0, 0, : -19, 0, 0, 0, : 3, 0, 0, -2, : -3, 0, 0, 1, : -6, 0, 0, 3, : -4, 0, 0, 0, : 3, 0, 0, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=651,660 ) / : 3, 0, 0, 0, : 4, 0, 0, 0, : 3, 0, 0, -1, : 6, 0, 0, -3, : -8, 0, 0, 3, : 0, 3, 1, 0, : -3, 0, 0, 0, : 0, -3, -2, 0, : 126, -63, -27, -55, : -5, 0, 1, 2 / DATA ( ( ICPL(I,J), I=1,4 ), J=661,670 ) / : -3, 28, 15, 2, : 5, 0, 1, -2, : 0, 9, 4, 1, : 0, 9, 4, -1, : -126, -63, -27, 55, : 3, 0, 0, -1, : 21, -11, -6, -11, : 0, -4, 0, 0, : -21, -11, -6, 11, : -3, 0, 0, 1 / DATA ( ( ICPL(I,J), I=1,4 ), J=671,680 ) / : 0, 3, 1, 0, : 8, 0, 0, -4, : -6, 0, 0, 3, : -3, 0, 0, 1, : 3, 0, 0, -1, : -3, 0, 0, 1, : -5, 0, 0, 2, : 24, -12, -5, -11, : 0, 3, 1, 0, : 0, 3, 1, 0 / DATA ( ( ICPL(I,J), I=1,4 ), J=681,687 ) / : 0, 3, 2, 0, : -24, -12, -5, 10, : 4, 0, -1, -2, : 13, 0, 0, -6, : 7, 0, 0, -3, : 3, 0, 0, -1, : 3, 0, 0, -1 / * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental DATE J2000.0 and given DATE (JC). T = ( ( DATE1-DJ0 ) + DATE2 ) / DJC * ------------------- * LUNI-SOLAR NUTATION * ------------------- * * Fundamental (Delaunay) arguments from Simon et al. (1994) * * Mean anomaly of the Moon. EL = MOD ( 485868.249036D0 + : T*( 1717915923.2178D0 + : T*( 31.8792D0 + : T*( 0.051635D0 + : T*( - 0.00024470D0 )))), TURNAS ) * DAS2R * Mean anomaly of the Sun. ELP = MOD ( 1287104.79305D0 + : T*( 129596581.0481D0 + : T*( - 0.5532D0 + : T*( 0.000136D0 + : T*( - 0.00001149D0 )))), TURNAS ) * DAS2R * Mean argument of the latitude of the Moon. F = MOD ( 335779.526232D0 + : T*( 1739527262.8478D0 + : T*( - 12.7512D0 + : T*( - 0.001037D0 + : T*( 0.00000417D0 )))), TURNAS ) * DAS2R * Mean elongation of the Moon from the Sun. D = MOD ( 1072260.70369D0 + : T*( 1602961601.2090D0 + : T*( - 6.3706D0 + : T*( 0.006593D0 + : T*( - 0.00003169D0 )))), TURNAS ) * DAS2R * Mean longitude of the ascending node of the Moon. OM = MOD ( 450160.398036D0 + : T*( - 6962890.5431D0 + : T*( 7.4722D0 + : T*( 0.007702D0 + : T*( - 0.00005939D0 )))), TURNAS ) * DAS2R * Initialize the nutation values. DP = 0D0 DE = 0D0 * Summation of luni-solar nutation series (in reverse order). DO 100 I = NLS, 1, -1 * Argument and functions. ARG = MOD ( DBLE ( NALS(1,I) ) * EL + : DBLE ( NALS(2,I) ) * ELP + : DBLE ( NALS(3,I) ) * F + : DBLE ( NALS(4,I) ) * D + : DBLE ( NALS(5,I) ) * OM, D2PI ) SARG = SIN(ARG) CARG = COS(ARG) * Term. DP = DP + ( CLS(1,I) + CLS(2,I) * T ) * SARG : + CLS(3,I) * CARG DE = DE + ( CLS(4,I) + CLS(5,I) * T ) * CARG : + CLS(6,I) * SARG 100 CONTINUE * Convert from 0.1 microarcsec units to radians. DPSILS = DP * U2R DEPSLS = DE * U2R * ------------------ * PLANETARY NUTATION * ------------------ * n.b. The MHB_2000 computes the luni-solar and planetary nutation in * different routines, using slightly different Delaunay arguments * in the two cases. This behaviour is faithfully reproduced * here. Use of the Simon et al. expressions for both cases leads * to negligible changes, well below 0.1 microarcsecond. * Mean anomaly of the Moon. AL = MOD ( 2.35555598D0 + 8328.6914269554D0 * T, D2PI ) * Mean anomaly of the Sun. ALSU = MOD ( 6.24006013D0 + 628.301955D0 * T, D2PI ) * Mean argument of the latitude of the Moon. AF = MOD ( 1.627905234D0 + 8433.466158131D0 * T, D2PI ) * Mean elongation of the Moon from the Sun. AD = MOD ( 5.198466741D0 + 7771.3771468121D0 * T, D2PI ) * Mean longitude of the ascending node of the Moon. AOM = MOD ( 2.18243920D0 - 33.757045D0 * T, D2PI ) * General accumulated precession in longitude. APA = ( 0.02438175D0 + 0.00000538691D0 * T ) * T * Planetary longitudes, Mercury through Neptune (Souchay et al. 1999). ALME = MOD ( 4.402608842D0 + 2608.7903141574D0 * T, D2PI ) ALVE = MOD ( 3.176146697D0 + 1021.3285546211D0 * T, D2PI ) ALEA = MOD ( 1.753470314D0 + 628.3075849991D0 * T, D2PI ) ALMA = MOD ( 6.203480913D0 + 334.0612426700D0 * T, D2PI ) ALJU = MOD ( 0.599546497D0 + 52.9690962641D0 * T, D2PI ) ALSA = MOD ( 0.874016757D0 + 21.3299104960D0 * T, D2PI ) ALUR = MOD ( 5.481293871D0 + 7.4781598567D0 * T, D2PI ) ALNE = MOD ( 5.321159000D0 + 3.8127774000D0 * T, D2PI ) * Initialize the nutation values. DP = 0D0 DE = 0D0 * Summation of planetary nutation series (in reverse order). DO 200 I = NPL, 1, -1 * Argument and functions. ARG = MOD ( DBLE ( NAPL( 1,I) ) * AL + : DBLE ( NAPL( 2,I) ) * ALSU + : DBLE ( NAPL( 3,I) ) * AF + : DBLE ( NAPL( 4,I) ) * AD + : DBLE ( NAPL( 5,I) ) * AOM + : DBLE ( NAPL( 6,I) ) * ALME + : DBLE ( NAPL( 7,I) ) * ALVE + : DBLE ( NAPL( 8,I) ) * ALEA + : DBLE ( NAPL( 9,I) ) * ALMA + : DBLE ( NAPL(10,I) ) * ALJU + : DBLE ( NAPL(11,I) ) * ALSA + : DBLE ( NAPL(12,I) ) * ALUR + : DBLE ( NAPL(13,I) ) * ALNE + : DBLE ( NAPL(14,I) ) * APA, D2PI ) SARG = SIN(ARG) CARG = COS(ARG) * Term. DP = DP + DBLE( ICPL(1,I)) * SARG + DBLE( ICPL(2,I)) * CARG DE = DE + DBLE( ICPL(3,I)) * SARG + DBLE( ICPL(4,I)) * CARG 200 CONTINUE * Convert from 0.1 microarcsec units to radians. DPSIPL = DP * U2R DEPSPL = DE * U2R * ------- * RESULTS * ------- * Add luni-solar and planetary components. DPSI = DPSILS + DPSIPL DEPS = DEPSLS + DEPSPL * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_BP00 ( DATE1, DATE2, RB, RP, RBP ) *+ * - - - - - - - - - * i a u _ B P 0 0 * - - - - - - - - - * * Frame bias and precession, IAU 2000. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * RB d(3,3) frame bias matrix (Note 2) * RP d(3,3) precession matrix (Note 3) * RBP d(3,3) bias-precession matrix (Note 4) * * Notes: * * 1) The TT date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others: * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The matrix RB transforms vectors from GCRS to mean J2000 by * applying frame bias. * * 3) The matrix RP transforms vectors from mean J2000 to mean of date * by applying precession. * * 4) The matrix RBP transforms vectors from GCRS to mean of date by * applying frame bias then precession. It is the product RP x RB. * * Called: * iau_BI00 IAU 2000 frame bias components * iau_PR00 IAU 2000 precession adjustments * iau_IR initialize r-matrix to identity * iau_RX rotate around X-axis * iau_RY rotate around Y-axis * iau_RZ rotate around Z-axis * iau_RXR r-matrix product * * Reference: * * Capitaine, N., Chapront, J., Lambert, S. and Wallace, P., * "Expressions for the Celestial Intermediate Pole and Celestial * Ephemeris Origin consistent with the IAU 2000A precession-nutation * model", submitted to A&A (2002) * * This revision: 2003 January 21 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, RB(3,3), RP(3,3), RBP(3,3) * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) * J2000 obliquity (Lieske et al. 1977) DOUBLE PRECISION EPS0 PARAMETER ( EPS0 = 84381.448D0 * DAS2R ) DOUBLE PRECISION T, DPSIBI, DEPSBI, DRA0, : PSIA77, OMA77, CHIA, DPSIPR, DEPSPR, PSIA, OMA * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and current date (JC). T = ( ( DATE1-DJ0 ) + DATE2 ) / DJC * Frame bias. CALL iau_BI00 ( DPSIBI, DEPSBI, DRA0 ) * Precession angles (Lieske et al. 1977) PSIA77 = ( 5038.7784D0 + : ( -1.07259D0 + : ( -0.001147D0 ) * T ) * T ) * T * DAS2R OMA77 = EPS0 + ( : ( 0.05127D0 + : ( -0.007726D0 ) * T ) * T ) * T * DAS2R CHIA = ( 10.5526D0 + : ( -2.38064D0 + : ( -0.001125D0 ) * T ) * T ) * T * DAS2R * Apply IAU 2000 precession corrections. CALL iau_PR00 ( DATE1, DATE2, DPSIPR, DEPSPR ) PSIA = PSIA77 + DPSIPR OMA = OMA77 + DEPSPR * Frame bias matrix: GCRS to J2000. CALL iau_IR ( RB ) CALL iau_RZ ( DRA0, RB ) CALL iau_RY ( DPSIBI*SIN(EPS0), RB ) CALL iau_RX ( -DEPSBI, RB ) * Precession matrix: J2000 to mean of date. CALL iau_IR ( RP ) CALL iau_RX ( EPS0, RP ) CALL iau_RZ ( -PSIA, RP ) CALL iau_RX ( -OMA, RP ) CALL iau_RZ ( CHIA, RP ) * Bias-precession matrix: GCRS to mean of date. CALL iau_RXR ( RP, RB, RBP ) * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_PR00 ( DATE1, DATE2, DPSIPR, DEPSPR ) *+ * - - - - - - - - - * i a u _ P R 0 0 * - - - - - - - - - * * Precession-rate part of the IAU 2000 precession-nutation models * (part of MHB_2000). * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Given: * DATE1,DATE2 d TT as a 2-part Julian Date (Note 1) * * Returned: * DPSIPR,DEPSPR d precession corrections (Notes 2,3) * * Notes * * 1) The T date DATE1+DATE2 is a Julian Date, apportioned in any * convenient way between the two arguments. For example, * JD(TT)=2450123.7 could be expressed in any of these ways, * among others * * DATE1 DATE2 * * 2450123.7D0 0D0 (JD method) * 2451545D0 -1421.3D0 (J2000 method) * 2400000.5D0 50123.2D0 (MJD method) * 2450123.5D0 0.2D0 (date & time method) * * The JD method is the most natural and convenient to use in * cases where the loss of several decimal digits of resolution * is acceptable. The J2000 method is best matched to the way * the argument is handled internally and will deliver the * optimum resolution. The MJD method and the date & time methods * are both good compromises between resolution and convenience. * * 2) The precession adjustments are expressed as "nutation components", * corrections in longitude and obliquity with respect to the J2000 * equinox and ecliptic. * * 3) Although the precession adjustments are stated to be with respect * to Lieske et al. (1977), the MHB_2000 model does not specify which * set of Euler angles are to be used and how the adjustments are to * be applied. The most literal and straightforward procedure is to * adopt the 4-rotation epsilon_0, psi_A, omega_A, xi_A option, and * to add DPSIPR to psi_A and DEPSPR to both omega_A and eps_A * (Wallace 2002). * * 4) This is an implementation of one aspect of the IAU 2000A nutation * model, formally adopted by the IAU General Assembly in 2000, * namely MHB2000 (Mathews et al. 2002). * * References * * 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-16, 1977. * * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation * and precession New nutation series for nonrigid Earth and * insights into the Earth's interior", J.Geophys.Res., 107, B4, * 2002. The MHB_2000 code itself was obtained on 9th September 2002 * from ftp //maia.usno.navy.mil/conv2000/chapter5/IAU2000A. * * Wallace, P.T., "Software for Implementing the IAU 2000 * Resolutions", in IERS Workshop 5.1, 2002. * * This revision: 2002 December 23 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DATE1, DATE2, DPSIPR, DEPSPR * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * Reference epoch (J2000), JD DOUBLE PRECISION DJ0 PARAMETER ( DJ0 = 2451545D0 ) * Days per Julian century DOUBLE PRECISION DJC PARAMETER ( DJC = 36525D0 ) DOUBLE PRECISION T * ------------------------------------ * Precession and obliquity corrections (radians per century) * ------------------------------------ DOUBLE PRECISION PRECOR, OBLCOR PARAMETER ( PRECOR = -0.29965D0 * DAS2R, : OBLCOR = -0.02524D0 * DAS2R ) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Interval between fundamental epoch J2000.0 and given date (JC). T = ( ( DATE1-DJ0 ) + DATE2 ) / DJC * Precession rate contributions with respect to IAU 1976/80. DPSIPR = PRECOR * T DEPSPR = OBLCOR * T * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END SUBROUTINE iau_BI00 ( DPSIBI, DEPSBI, DRA ) *+ * - - - - - - - - - * i a u _ B I 0 0 * - - - - - - - - - * * Frame bias components of IAU 2000 precession-nutation models (part of * MHB_2000 with additions). * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: canonical model. * * Returned: * DPSIBI,DEPSBI d longitude and obliquity corrections * DRA d the ICRS RA of the J2000 mean equinox * * Notes * * 1) The frame bias corrections in longitude and obliquity (radians) * are required in order to correct for the offset between the GCRS * pole and the mean J2000 pole. They define, with respect to the * GCRS frame, a J2000 mean pole that is consistent with the rest of * the IAU 2000A precession-nutation model. * * 2) In addition to the displacement of the pole, the complete * description of the frame bias requires also an offset in right * ascension. This is not part of the IAU 2000A model, and is from * Chapront et al. (2002). It is returned in radians. * * 3) This is a supplemented implementation of one aspect of the IAU * 2000A nutation model, formally adopted by the IAU General Assembly * in 2000, namely MHB2000 (Mathews et al. 2002). * * References * * Chapront, J., Chapront-Touze, M. & Francou, G., Astron.Astrophys., * 387, 700, 2002. * * Mathews, P.M., Herring, T.A., Buffet, B.A., "Modeling of nutation * and precession New nutation series for nonrigid Earth and * insights into the Earth's interior", J.Geophys.Res., 107, B4, * 2002. The MHB_2000 code itself was obtained on 9th September 2002 * from ftp //maia.usno.navy.mil/conv2000/chapter5/IAU2000A. * * This revision: 2002 December 23 * * Copyright (C) 2003 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE DOUBLE PRECISION DPSIBI, DEPSBI, DRA * Arcseconds to radians DOUBLE PRECISION DAS2R PARAMETER ( DAS2R = 4.848136811095359935899141D-6 ) * The frame bias corrections in longitude and obliquity DOUBLE PRECISION DPBIAS, DEBIAS PARAMETER ( DPBIAS = -0.041775D0 * DAS2R, : DEBIAS = -0.0068192D0 * DAS2R ) * The ICRS RA of the J2000 equinox (Chapront et al., 2002) DOUBLE PRECISION DRA0 PARAMETER ( DRA0 = -0.0146D0 * DAS2R ) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Return the results (which are fixed). DPSIBI = DPBIAS DEPSBI = DEBIAS DRA = DRA0 * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2003 * Standards Of Fundamental Astronomy Review Board * of the International Astronomical Union. * * ===================== * SOFA Software License * ===================== * * NOTICE TO USER: * * BY USING THIS SOFTWARE YOU ACCEPT THE FOLLOWING TERMS AND CONDITIONS * WHICH APPLY TO ITS USE. * * 1. The Software is owned by the IAU SOFA Review Board ("the Board"). * * 2. The Software is made available free of charge for use by: * * a) private individuals for non-profit research; and * * b) non-profit educational, academic and research institutions. * * 3. Commercial use of the Software is specifically excluded from the * terms and conditions of this license. Commercial use of the * Software is subject to the prior written agreement of the Board on * terms to be agreed. * * 4. The provision of any version of the 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. * * 5. The user may modify the Software for his/her own purposes. The * user may distribute the modified software provided that the Board * is informed and that a copy of the modified software is made * available to the Board on request. All modifications made by the * user shall be clearly identified to show how the modified software * differs from the original Software, and the name(s) of the * affected routine(s) shall be changed. The original SOFA Software * License text must be present. * * 6. In any published work produced by the user and which includes * results achieved by using the Software, the user shall acknowledge * that the Software was used in producing the information contained * in such publication. * * 7. The user may incorporate or embed the Software into other software * products which he/she may then give away free of charge but not * sell provided the user makes due acknowledgement of the use which * he/she has made of the Software in creating such software * products. Any redistribution of the Software in this way shall be * made under the same terms and conditions under which the user * received it from the SOFA Center. * * 8. The user shall not cause the Software to be brought into * disrepute, either by misuse, or use for inappropriate tasks, or by * inappropriate modification. * * 9. The Software is provided to the user "as is" and the Board makes * no warranty as to its use or performance. The Board does not and * cannot warrant the performance or results which the user may * obtain by using the Software. The Board 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 the Board be liable to the user for any consequential, * incidental, or special damages, including any lost profits or lost * savings, even if a Board representative has been advised of such * damages, or for any claim by any third party. * * Correspondence concerning SOFA software should be addressed as * follows: * * Internet email: sofa@rl.ac.uk * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END