Line data Source code
1 : !-----------------------------------------------------------------------
2 : !$Id$
3 : !===============================================================================
4 : module calendar
5 :
6 : implicit none
7 :
8 : public :: gregorian2julian_date, julian2gregorian_date, &
9 : leap_year, compute_current_date, &
10 : gregorian2julian_day
11 :
12 : private ! Default Scope
13 :
14 : ! Constant Parameters
15 :
16 : ! 3 Letter Month Abbreviations
17 : character(len=3), dimension(12), public, parameter :: &
18 : month_names = (/'JAN','FEB','MAR','APR','MAY','JUN', &
19 : 'JUL','AUG','SEP','OCT','NOV','DEC'/)
20 :
21 : ! Number of days per month (Jan..Dec) for a non leap year
22 : integer, public, dimension(12), parameter :: &
23 : days_per_month = (/31, 28, 31, 30, 31, 30, &
24 : 31, 31, 30, 31, 30, 31/)
25 :
26 : contains
27 : !-----------------------------------------------------------------------
28 0 : integer function gregorian2julian_date( day, month, year )
29 : !
30 : ! Description:
31 : ! Computes the Julian Date (gregorian2julian), or the number of days since
32 : ! 1 January 4713 BC, given a Gregorian Calender date (day, month, year).
33 : !
34 : ! Reference:
35 : ! Fliegel, H. F. and van Flandern, T. C.,
36 : ! Communications of the ACM, Vol. 11, No. 10 (October, 1968)
37 : !----------------------------------------------------------------------
38 :
39 : implicit none
40 :
41 : ! Input Variables
42 : integer, intent(in) :: &
43 : day, & ! Gregorian Calendar Day for given Month [dd]
44 : month, & ! Gregorian Calendar Month for given Year [mm]
45 : year ! Gregorian Calendar Year [yyyy]
46 :
47 : ! Local Variables
48 : integer :: I,J,K
49 :
50 0 : I = year
51 0 : J = month
52 0 : K = day
53 :
54 : gregorian2julian_date = K-32075+1461*(I+4800+(J-14)/12)/4+367* &
55 0 : (J-2-(J-14)/12*12)/12-3*((I+4900+(J-14)/12)/100)/4
56 :
57 : return
58 : end function gregorian2julian_date
59 :
60 : !------------------------------------------------------------------
61 0 : subroutine julian2gregorian_date &
62 : ( julian_date, &
63 : day, month, year )
64 : !
65 : ! Description:
66 : ! Computes the Gregorina Calendar date (day, month, year)
67 : ! given the Julian date (julian_date).
68 : !
69 : ! Reference:
70 : ! Fliegel, H. F. and van Flandern, T. C.,
71 : ! Communications of the ACM, Vol. 11, No. 10 (October, 1968)
72 : ! http://portal.acm.org/citation.cfm?id=364097
73 : !------------------------------------------------------------------
74 : implicit none
75 :
76 : ! Input Variable(s)
77 : integer, intent(in) :: julian_date ! Julian date being converted from
78 :
79 : ! Output Variable(s)
80 : integer, intent(out):: &
81 : day, & ! Gregorian calender day for given Month [dd]
82 : month, & ! Gregorian calender month for given Year [mm]
83 : year ! Gregorian calender year [yyyy]
84 :
85 : ! Local Variables
86 : integer :: i, j, k, n, l
87 :
88 : ! ---- Begin Code ----
89 :
90 0 : L = julian_date+68569 ! Known magic number
91 0 : N = 4*L/146097 ! Known magic number
92 0 : L = L-(146097*N+3)/4 ! Known magic number
93 0 : I = 4000*(L+1)/1461001 ! Known magic number
94 0 : L = L-1461*I/4+31 ! Known magic number
95 0 : J = 80*L/2447 ! Known magic number
96 0 : K = L-2447*J/80 ! Known magic number
97 0 : L = J/11 ! Known magic number
98 0 : J = J+2-12*L ! Known magic number
99 0 : I = 100*(N-49)+I+L ! Known magic number
100 :
101 0 : year = I
102 0 : month = J
103 0 : day = K
104 :
105 0 : return
106 :
107 : end subroutine julian2gregorian_date
108 :
109 : !-----------------------------------------------------------------------------
110 0 : logical function leap_year( year )
111 : !
112 : ! Description:
113 : ! Determines if the given year is a leap year.
114 : !
115 : ! References:
116 : ! None
117 : !-----------------------------------------------------------------------------
118 : implicit none
119 :
120 : ! External
121 : intrinsic :: mod
122 :
123 : ! Input Variable(s)
124 : integer, intent(in) :: year ! Gregorian Calendar Year [yyyy]
125 :
126 : ! ---- Begin Code ----
127 :
128 : leap_year = ( (mod( year, 4 ) == 0) .and. &
129 0 : (.not.( mod( year, 100 ) == 0 .and. mod( year, 400 ) /= 0 ) ) )
130 :
131 : return
132 : end function leap_year
133 :
134 : !----------------------------------------------------------------------------
135 0 : subroutine compute_current_date( previous_day, previous_month, &
136 : previous_year, &
137 : seconds_since_previous_date, &
138 : current_day, current_month, &
139 : current_year, &
140 : seconds_since_current_date )
141 : !
142 : ! Description:
143 : ! Computes the current Gregorian date from a previous date and
144 : ! the seconds that have transpired since that date.
145 : !
146 : ! References:
147 : ! None
148 : !----------------------------------------------------------------------------
149 : use clubb_precision, only: &
150 : time_precision ! Variable(s)
151 :
152 : use constants_clubb, only: &
153 : sec_per_day ! Variable(s)
154 :
155 : implicit none
156 :
157 : ! Input Variable(s)
158 :
159 : ! Previous date
160 : integer, intent(in) :: &
161 : previous_day, & ! Day of the month [dd]
162 : previous_month, & ! Month of the year [mm]
163 : previous_year ! Year [yyyy]
164 :
165 : real(kind=time_precision), intent(in) :: &
166 : seconds_since_previous_date ! [s]
167 :
168 : ! Output Variable(s)
169 :
170 : ! Current date
171 : integer, intent(out) :: &
172 : current_day, & ! Day of the month [dd]
173 : current_month, & ! Month of the year [mm]
174 : current_year ! Year [yyyy]
175 :
176 : real(kind=time_precision), intent(out) :: &
177 : seconds_since_current_date
178 :
179 : integer :: &
180 : days_since_1jan4713bc, &
181 : days_since_start
182 :
183 : ! ---- Begin Code ----
184 :
185 : ! Using Julian dates we are able to add the days that the model
186 : ! has been running
187 :
188 : ! Determine the Julian Date of the starting date,
189 : ! written in Gregorian (day, month, year) form
190 : days_since_1jan4713bc = gregorian2julian_date( previous_day, &
191 0 : previous_month, previous_year )
192 :
193 : ! Determine the amount of days that have passed since start date
194 : days_since_start = &
195 0 : floor( seconds_since_previous_date / real(sec_per_day,kind=time_precision) )
196 :
197 : ! Set days_since_1jan4713 to the present Julian date
198 0 : days_since_1jan4713bc = days_since_1jan4713bc + days_since_start
199 :
200 : ! Set Present time to be seconds since the Julian date
201 : seconds_since_current_date = seconds_since_previous_date &
202 0 : - ( real( days_since_start, kind=time_precision ) * real(sec_per_day,kind=time_precision) )
203 :
204 : call julian2gregorian_date &
205 : ( days_since_1jan4713bc, & ! intent(in)
206 0 : current_day, current_month, current_year ) ! intent(out)
207 :
208 0 : return
209 : end subroutine compute_current_date
210 :
211 : !-------------------------------------------------------------------------------------
212 0 : integer function gregorian2julian_day( day, month, year )
213 : !
214 : ! Description:
215 : ! This subroutine determines the Julian day (1-366)
216 : ! for a given Gregorian calendar date(e.g. July 1, 2008).
217 : !
218 : ! References:
219 : ! None
220 : !-------------------------------------------------------------------------------------
221 :
222 : implicit none
223 :
224 : ! External
225 : intrinsic :: sum
226 :
227 : ! Input Variable(s)
228 : integer, intent(in) :: &
229 : day, & ! Day of the Month [dd]
230 : month, & ! Month of the Year [mm]
231 : year ! Year [yyyy]
232 :
233 : ! ---- Begin Code ----
234 :
235 : ! Add the days from the previous months
236 0 : gregorian2julian_day = day + sum( days_per_month(1:month-1) )
237 :
238 : ! Kluge for a leap year
239 : ! If the date were 29 Feb 2000 this would not increment julian_day
240 : ! However 01 March 2000 would need the 1 day bump
241 0 : if ( leap_year( year ) .and. month > 2 ) then
242 0 : gregorian2julian_day = gregorian2julian_day + 1
243 : end if
244 :
245 0 : if ( ( leap_year( year ) .and. gregorian2julian_day > 366 ) .or. &
246 : ( .not. leap_year( year ) .and. gregorian2julian_day > 365 ) ) then
247 0 : error stop "Problem with Julian day conversion in gregorian2julian_day."
248 : end if
249 :
250 : return
251 : end function gregorian2julian_day
252 :
253 : end module calendar
|
