Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: julday_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_JULDAY\_MOD contains routines used to convert from
9 : ! month/day/year to Astronomical Julian Date and back again.
10 : !\\
11 : !\\
12 : ! !INTERFACE:
13 : !
14 : MODULE HCO_JULDAY_MOD
15 : !
16 : ! !USES:
17 : !
18 : USE HCO_PRECISION_MOD ! For GEOS-Chem Precision (fp)
19 :
20 : IMPLICIT NONE
21 : PRIVATE
22 : !
23 : ! !PUBLIC MEMBER FUNCTIONS:
24 : !
25 : PUBLIC :: JULDAY
26 : PUBLIC :: CALDATE
27 : !
28 : ! !PRIVATE MEMBER FUNCTIONS:
29 : !
30 : PRIVATE :: MINT
31 : !
32 : ! !REVISION HISTORY:
33 : ! See https://github.com/geoschem/hemco for complete history
34 : !EOP
35 : !------------------------------------------------------------------------------
36 : !BOC
37 : CONTAINS
38 : !EOC
39 : !------------------------------------------------------------------------------
40 : ! Harmonized Emissions Component (HEMCO) !
41 : !------------------------------------------------------------------------------
42 : !BOP
43 : !
44 : ! !IROUTINE: JulDay
45 : !
46 : ! !DESCRIPTION: Function JULDAY returns the astronomical Julian day.
47 : !\\
48 : !\\
49 : ! !INTERFACE:
50 : !
51 0 : FUNCTION JULDAY( YYYY, MM, DD ) RESULT( JULIANDAY )
52 : !
53 : ! !INPUT PARAMETERS:
54 : !
55 : INTEGER, INTENT(IN) :: YYYY ! Year (must be in 4-digit format!)
56 : INTEGER, INTENT(IN) :: MM ! Month (1-12)
57 : REAL*8, INTENT(IN) :: DD ! Day of month (may be fractional!)
58 : !
59 : ! !RETURN VALUE:
60 : !
61 : REAL*8 :: JULIANDAY ! Astronomical Julian Date
62 : !
63 : ! !REMARKS:
64 : ! (1) Algorithm taken from "Practical Astronomy With Your Calculator",
65 : ! Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
66 : ! (2) Requires the external function MINT.F.
67 : ! (3) JulDay will compute the correct Julian day for any BC or AD date.
68 : ! (4) For BC dates, subtract 1 from the year and append a minus sign.
69 : ! For example, 1 BC is 0, 2 BC is -1, etc. This is necessary for
70 : ! the algorithm.
71 : !
72 : ! !REVISION HISTORY:
73 : ! 26 Nov 2001 - R. Yantosca - Initial version
74 : ! See https://github.com/geoschem/hemco for complete history
75 : !EOP
76 : !------------------------------------------------------------------------------
77 : !BOC
78 : !
79 : ! !LOCAL VARIABLES:
80 : !
81 : INTEGER :: YEAR1, MONTH1
82 : REAL*8 :: X1, A, B, C, D
83 : LOGICAL :: ISGREGORIAN
84 :
85 : !==================================================================
86 : ! JULDAY begins here!
87 : !
88 : ! Follow algorithm from Peter Duffett-Smith (1992)
89 : !==================================================================
90 :
91 : ! Compute YEAR and MONTH1
92 0 : IF ( ( MM == 1 ) .OR. ( MM == 2 ) ) THEN
93 0 : YEAR1 = YYYY - 1
94 0 : MONTH1 = MM + 12
95 : ELSE
96 0 : YEAR1 = YYYY
97 0 : MONTH1 = MM
98 : ENDIF
99 :
100 : ! Compute the "A" term.
101 0 : X1 = DBLE( YEAR1 ) / 100.0d0
102 0 : A = MINT( X1 )
103 :
104 : ! The Gregorian calendar begins on 10 October 1582
105 : ! Any dates prior to this will be in the Julian calendar
106 0 : IF ( YYYY > 1582 ) THEN
107 : ISGREGORIAN = .TRUE.
108 : ELSE
109 : IF ( ( YYYY == 1582 ) .AND. &
110 0 : ( MONTH1 >= 10 ) .AND. &
111 : ( DD >= 15.0 ) ) THEN
112 : ISGREGORIAN = .TRUE.
113 : ELSE
114 : ISGREGORIAN = .FALSE.
115 : ENDIF
116 : ENDIF
117 :
118 : ! Compute the "B" term according to Gregorian or Julian calendar
119 : IF ( ISGREGORIAN ) THEN
120 0 : B = 2.0d0 - A + MINT( A / 4.0d0 )
121 : ELSE
122 : B = 0.0d0
123 : ENDIF
124 :
125 : ! Compute the "C" term for BC dates (YEAR1 <= 0 )
126 : ! or AD dates (YEAR1 > 0)
127 0 : IF ( YEAR1 < 0 ) THEN
128 0 : X1 = ( 365.25d0 * YEAR1 ) - 0.75d0
129 0 : C = MINT( X1 )
130 : ELSE
131 0 : X1 = 365.25d0 * YEAR1
132 0 : C = MINT( X1 )
133 : ENDIF
134 :
135 : ! Compute the "D" term
136 0 : X1 = 30.6001d0 * DBLE( MONTH1 + 1 )
137 0 : D = MINT( X1 )
138 :
139 : ! Add the terms to get the Julian Day number
140 0 : JULIANDAY = B + C + D + DD + 1720994.5d0
141 :
142 0 : END FUNCTION JULDAY
143 : !EOC
144 : !------------------------------------------------------------------------------
145 : ! Harmonized Emissions Component (HEMCO) !
146 : !------------------------------------------------------------------------------
147 : !BOP
148 : !
149 : ! !IROUTINE: Mint
150 : !
151 : ! !DESCRIPTION: Function MINT is the modified integer function.
152 : !\\
153 : !\\
154 : ! !INTERFACE:
155 : !
156 0 : FUNCTION MINT( X ) RESULT ( VALUE )
157 : !
158 : ! !INPUT PARAMETERS:
159 : !
160 : REAL*8, INTENT(IN) :: X
161 : !
162 : ! !RETURN VALUE:
163 : !
164 : REAL*8 :: VALUE
165 : !
166 : ! !REMARKS:
167 : ! The modified integer function is defined as follows:
168 : !
169 : ! { -INT( ABS( X ) ) for X < 0
170 : ! MINT = {
171 : ! { INT( ABS( X ) ) for X >= 0
172 : !
173 : ! !REVISION HISTORY:
174 : ! 20 Nov 2001 - R. Yantosca - Initial version
175 : ! See https://github.com/geoschem/hemco for complete history
176 : !EOP
177 : !------------------------------------------------------------------------------
178 : !BOC
179 0 : IF ( X < 0d0 ) THEN
180 0 : VALUE = -INT( ABS( X ) )
181 : ELSE
182 0 : VALUE = INT( ABS( X ) )
183 : ENDIF
184 :
185 0 : END FUNCTION MINT
186 : !EOC
187 : !------------------------------------------------------------------------------
188 : ! Harmonized Emissions Component (HEMCO) !
189 : !------------------------------------------------------------------------------
190 : !BOP
191 : !
192 : ! !IROUTINE: CalDate
193 : !
194 : ! !DESCRIPTION: Subroutine CALDATE converts an astronomical Julian day to
195 : ! the YYYYMMDD and HHMMSS format.
196 : !\\
197 : !\\
198 : ! !INTERFACE:
199 : !
200 0 : SUBROUTINE CALDATE( JULIANDAY, YYYYMMDD, HHMMSS )
201 : !
202 : ! !INPUT PARAMETERS:
203 : !
204 : REAL*8, INTENT(IN) :: JULIANDAY ! Astronomical Julian Date
205 : !
206 : ! !OUTPUT PARAMETERS:
207 : !
208 : INTEGER, INTENT(OUT) :: YYYYMMDD ! Date in YYYY/MM/DD format
209 : INTEGER, INTENT(OUT) :: HHMMSS ! Time in hh:mm:ss format
210 : !
211 : ! !REMARKS:
212 : ! Algorithm taken from "Practical Astronomy With Your Calculator",
213 : ! Third Edition, by Peter Duffett-Smith, Cambridge UP, 1992.
214 : !
215 : ! !REVISION HISTORY:
216 : ! See https://github.com/geoschem/hemco for complete history
217 : !EOP
218 : !------------------------------------------------------------------------------
219 : !BOC
220 : !
221 : ! !LOCAL VARIABLES:
222 : !
223 : REAL*4 :: HH, MM, SS
224 : REAL*8 :: A, B, C, D, DAY, E, F
225 : REAL*8 :: FDAY, G, I, J, JD, M, Y
226 :
227 : !=================================================================
228 : ! CALDATE begins here!
229 : ! See "Practical astronomy with your calculator", Peter Duffett-
230 : ! Smith 1992, for an explanation of the following algorithm.
231 : !=================================================================
232 0 : JD = JULIANDAY + 0.5d0
233 0 : I = INT( JD )
234 0 : F = JD - INT( I )
235 :
236 0 : IF ( I > 2299160d0 ) THEN
237 0 : A = INT( ( I - 1867216.25d0 ) / 36524.25d0 )
238 0 : B = I + 1 + A - INT( A / 4 )
239 : ELSE
240 : B = I
241 : ENDIF
242 :
243 0 : C = B + 1524d0
244 :
245 0 : D = INT( ( C - 122.1d0 ) / 365.25d0 )
246 :
247 0 : E = INT( 365.25d0 * D )
248 :
249 0 : G = INT( ( C - E ) / 30.6001d0 )
250 :
251 : ! DAY is the day number
252 0 : DAY = C - E + F - INT( 30.6001d0 * G )
253 :
254 : ! FDAY is the fractional day number
255 0 : FDAY = DAY - INT( DAY )
256 :
257 : ! M is the month number
258 0 : IF ( G < 13.5d0 ) THEN
259 0 : M = G - 1d0
260 : ELSE
261 0 : M = G - 13d0
262 : ENDIF
263 :
264 : ! Y is the year number
265 0 : IF ( M > 2.5d0 ) THEN
266 0 : Y = D - 4716d0
267 : ELSE
268 0 : Y = D - 4715d0
269 : ENDIF
270 :
271 : ! Year-month-day value
272 0 : YYYYMMDD = ( INT( Y ) * 10000 ) + ( INT( M ) * 100 ) + INT( DAY )
273 :
274 : ! Hour-minute-second value
275 : ! NOTE: HH, MM, SS are REAL*4 to avoid numerical roundoff errors
276 0 : HH = FDAY * 24d0
277 0 : MM = ( HH - INT( HH ) ) * 60d0
278 0 : SS = ( MM - INT( MM ) ) * 60d0
279 : !------------------------------------------------------------------
280 : ! NOTE: Some times (like 40min = 0.6666 hrs) will cause a roundoff
281 : ! error that will make the minutes eg. 39.9999 instead of 40.
282 : ! For now put in a kludge to rectify this situation.
283 0 : IF ( INT(SS) == 59 ) THEN
284 0 : SS = 0.0e0
285 0 : MM = NINT( MM )
286 : ENDIF
287 : !---------------------------------------------------------------
288 0 : HHMMSS = ( INT( HH ) * 10000 ) + ( INT( MM ) * 100 ) + INT( SS )
289 :
290 0 : END SUBROUTINE CALDATE
291 : !EOC
292 : END MODULE HCO_JULDAY_MOD
|
