|Posted||21 Apr 2006|
|Updated||21 Apr 2006|
|More by this author...|
Returns a Julian Date given a Gregorian date.
Requires [lp_date_stringtodate] [lp_date_localToUTC] [lp_decimal_precisionset]
'2443509.5 = ' lp_date_JulianDate: (date:'1978-01-01 00:00:00 GMT'); '
'; // 2443509.5 '2443711.125 = ' lp_date_JulianDate: (date:'1978-07-21 15:00:00 GMT'); '
'; // 2443711.125
Click the "Download" button below to retrieve a copy of this tag, including the complete documentation and sample usage shown on this page. Place the downloaded ".inc" file in your LassoStartup folder, restart Lasso, and you can begin using this tag immediately.
[ define_tag:'lp_date_JulianDate', -description='Returns a Julian Date given a Gregorian date.', -priority='replace', -required='date',-copy; // adapted from i a u _ C A L 2 J D // original Fortran version follows below if: #date->type != 'date'; #date = lp_date_stringtodate: (string: #date); /if; // convert to UTC/GMT #date = lp_date_localToUTC: #date; local:'d' = (integer: #date->day); local:'m' = (integer: #date->month); local:'y' = (integer: #date->year); local:'h' = (decimal: #date->hour); local:'n' = (decimal: #date->minute); local:'s' = (decimal: #date->second); local:'J' = integer; local:'MY' = integer; local:'IYPMY' = integer; local:'DJM0' = decimal; local:'DJM' = decimal; #MY = ( #m - 14 ) / 12; #IYPMY = #y + #MY; #DJM0 = 2400000.5; #DJM = decimal( ( 1461 * ( #IYPMY + 4800 ) ) / 4 + ( 367 * ( #m-2 - 12*#MY ) ) / 12 - ( 3 * ( ( #IYPMY + 4900 ) / 100 ) ) / 4 + #d - 2432076) + (#h / 24.0) + (#n / 1440.0) + (#s / 86400.0); return: lp_decimal_precisionset: #DJM + #DJM0; /define_tag; /* SUBROUTINE iau_CAL2JD ( IY, IM, ID, DJM0, DJM, J ) *+ * - - - - - - - - - - - * i a u _ C A L 2 J D * - - - - - - - - - - - * * Gregorian Calendar to Julian Date. * * This routine is part of the International Astronomical Union's * SOFA (Standards of Fundamental Astronomy) software collection. * * Status: support routine. * * Given: * IY,IM,ID i year, month, day in Gregorian calendar (Note 1) * * Returned: * DJM0 d MJD zero-point: always 2400000.5 * DJM d Modified Julian Date for 0 hrs * J i status: * 0 = OK * -1 = bad year (Note 3: JD not computed) * -2 = bad month (JD not computed) * -3 = bad day (JD computed) * * Notes: * * 1) The algorithm used is valid from -4800 March 1, but this * implementation rejects dates before -4799 January 1. * * 2) The Julian Date is returned in two pieces, in the usual SOFA * manner, which is designed to preserve time resolution. The * Julian Date is available as a single number by adding DJM0 and * DJM. * * 3) In early eras the conversion is from the "Proleptic Gregorian * Calendar"; no account is taken of the date(s) of adoption of * the Gregorian Calendar, nor is the AD/BC numbering convention * observed. * * Reference: * * Explanatory Supplement to the Astronomical Almanac, * P. Kenneth Seidelmann (ed), University Science Books (1992), * Section 12.92 (p604). * * This revision: 2001 September 16 * * Copyright (C) 2005 IAU SOFA Review Board. See notes at end. * *----------------------------------------------------------------------- IMPLICIT NONE INTEGER IY, IM, ID DOUBLE PRECISION DJM0, DJM INTEGER J, MY, IYPMY * Earliest year allowed (4800BC) INTEGER IYMIN PARAMETER ( IYMIN = -4799 ) * Month lengths in days INTEGER MTAB(12) DATA MTAB / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 / * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * Preset status. J = 0 * Validate year. IF ( IY.LT.IYMIN ) THEN J = -1 ELSE * Validate month. IF ( IM.GE.1 .AND. IM.LE.12 ) THEN * Allow for leap year. IF ( MOD(IY,4) .EQ. 0 ) THEN MTAB(2) = 29 ELSE MTAB(2) = 28 END IF IF ( MOD(IY,100).EQ.0 .AND. MOD(IY,400).NE.0 ) MTAB(2) = 28 * Validate day. IF ( ID.LT.1 .OR. ID.GT.MTAB(IM) ) J = -3 * Result. MY = ( IM - 14 ) / 12 IYPMY = IY + MY DJM0 = 2400000.5D0 DJM = DBLE( ( 1461 * ( IYPMY + 4800 ) ) / 4 : + ( 367 * ( IM-2 - 12*MY ) ) / 12 : - ( 3 * ( ( IYPMY + 4900 ) / 100 ) ) / 4 : + ID - 2432076) * Bad month ELSE J = -2 END IF END IF * Finished. *+---------------------------------------------------------------------- * * Copyright (C) 2005 * 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: email@example.com * Postal address: IAU SOFA Center * Rutherford Appleton Laboratory * Chilton, Didcot, Oxon OX11 0QX * United Kingdom * * *----------------------------------------------------------------------- END */ ]