source: XIOS/trunk/src/interface/fortran/icalendar.F90 @ 550

Last change on this file since 550 was 550, checked in by rlacroix, 9 years ago

Add a new user defined calendar type.

A new calendar type "user_defined" is now available. This allows the users to create a custom calendar that we can configured to be suitable for planets other than the Earth.

An user defined calendar is always defined by two mandatory attributes:

  • day_length: the duration of a day, in seconds
  • and either:
    • month_length: an array containing the duration of each month, in days (the number of elements in the array is the number of months in a year)
    • or year_length: the duration of a year, in seconds (in that case, the calendar does not have months).

If the calendar has months (i.e. month_length attribute is set) and only in that case, it is possible to define leap years in order to compensate for the duration of an astronomical year not being a multiple of the day length. The leap years are defined by two mandatory attributes:

  • leap_year_month: the month to which the extra day will be added in case of leap year, expressed as an integer number in the range [1, numberOfMonths]
  • and leap_year_drift: the fraction of a day representing the yearly drift between the calendar year and the astronomical year, expressed as a real number in the range [0, 1).

Optionally, one can define the leap_year_drift_offset attribute to set the original drift at the beginning of the time origin's year, again expressed as a real number in the range [0, 1). If leap_year_drift_offset + leap_year_drift is greater or equal to 1, then the first year will be a leap year.

For example, the following configuration creates a Gregorian-like calendar:

<calendar type="user_defined" start_date="2012-03-01 15:00:00" time_origin="2012-02-28 15:00:00 + 1d" day_length="86400" month_lengths="(1, 12) [31 28 31 30 31 30 31 31 30 31 30 31]" leap_year_month="2" leap_year_drift="0.25" leap_year_drift_offset="0.75" />

Note that dates attributes must be written differently in the configuration file when using an user defined calendar without months:

  • if the year length is greater than the day length, the input format is year-day hh:min:sec instead of year-month-day hh:min:sec
  • if the day length is greater or equal to the year length, the input format is year hh:min:sec.

In all cases, it is still possible to use the date + duration notation to build a date (with both the date and duration parts being optional).

The Fortran interface has been updated accordingly so that xios_define_calendar can accept the new attributes necessary to define custom calendars.

File size: 9.4 KB
Line 
1#include "xios_fortran_prefix.hpp"
2MODULE ICALENDAR
3   USE, INTRINSIC :: ISO_C_BINDING
4   USE CALENDAR_INTERFACE
5   USE ICALENDAR_WRAPPER
6   USE IDATE
7   USE IDURATION
8
9   ! enum XCalendarType
10   INTEGER(kind = C_INT), PARAMETER :: D360 = 0 , ALLLEAP = 1 , NOLEAP = 2 , JULIAN = 3 , GREGORIAN = 4
11
12   INTERFACE xios(set_start_date)
13      MODULE PROCEDURE xios(set_start_date_date), xios(set_start_date_dur)
14   END INTERFACE xios(set_start_date)
15
16   INTERFACE xios(set_time_origin)
17      MODULE PROCEDURE xios(set_time_origin_date), xios(set_time_origin_dur)
18   END INTERFACE xios(set_time_origin)
19
20   CONTAINS ! Fonctions disponibles pour les utilisateurs.
21
22   SUBROUTINE xios(define_calendar)(type, timestep, start_date, time_origin, &
23                                    day_length, month_lengths, year_length, &
24                                    leap_year_month, leap_year_drift, leap_year_drift_offset)
25      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
26      USE icalendar_wrapper_attr, ONLY : xios(set_calendar_wrapper_attr_hdl)
27      USE IDURATION, ONLY : txios(duration)
28      USE IDATE, ONLY : txios(date)
29      IMPLICIT NONE
30      CHARACTER(len = *),              INTENT(IN) :: type
31      TYPE(txios(duration)), OPTIONAL, INTENT(IN) :: timestep
32      TYPE(txios(date)),     OPTIONAL, INTENT(IN) :: start_date
33      TYPE(txios(date)),     OPTIONAL, INTENT(IN) :: time_origin
34      INTEGER,               OPTIONAL, INTENT(IN) :: day_length
35      INTEGER,               OPTIONAL, INTENT(IN) :: month_lengths(:)
36      INTEGER,               OPTIONAL, INTENT(IN) :: year_length
37      REAL (KIND=8),         OPTIONAL, INTENT(IN) :: leap_year_drift
38      REAL (KIND=8),         OPTIONAL, INTENT(IN) :: leap_year_drift_offset
39      INTEGER,               OPTIONAL, INTENT(IN) :: leap_year_month
40      TYPE(txios(calendar_wrapper)) :: calendar_wrapper
41
42      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
43
44      CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, type=type)
45      IF (PRESENT(timestep)) THEN
46         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep)
47      END IF
48      IF (PRESENT(day_length)) THEN
49         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, day_length=day_length)
50      END IF
51      IF (PRESENT(month_lengths)) THEN
52         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, month_lengths=month_lengths)
53      END IF
54      IF (PRESENT(year_length)) THEN
55         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, year_length=year_length)
56      END IF
57      IF (PRESENT(leap_year_month)) THEN
58         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, leap_year_month=leap_year_month)
59      END IF
60      IF (PRESENT(leap_year_drift)) THEN
61         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, leap_year_drift=leap_year_drift)
62      END IF
63      IF (PRESENT(leap_year_drift_offset)) THEN
64         CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, leap_year_drift_offset=leap_year_drift_offset)
65      END IF
66
67      CALL xios(create_calendar)(calendar_wrapper)
68
69      IF (PRESENT(start_date)) THEN
70         CALL xios(set_start_date_hdl)(calendar_wrapper, start_date=start_date)
71      END IF
72      IF (PRESENT(time_origin)) THEN
73         CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin=time_origin)
74      END IF
75   END SUBROUTINE xios(define_calendar)
76
77   SUBROUTINE xios(get_calendar_type)(calendar_type)
78      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
79      USE icalendar_wrapper_attr, ONLY : xios(get_calendar_wrapper_attr_hdl)
80      IMPLICIT NONE
81      CHARACTER(len = *), INTENT(OUT) :: calendar_type
82      TYPE(txios(calendar_wrapper))   :: calendar_wrapper
83
84      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
85
86      CALL xios(get_calendar_wrapper_attr_hdl)(calendar_wrapper, type=calendar_type)
87   END SUBROUTINE xios(get_calendar_type)
88
89   SUBROUTINE xios(set_timestep)(timestep)
90      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
91      USE icalendar_wrapper_attr, ONLY : xios(set_calendar_wrapper_attr_hdl)
92      USE IDURATION, ONLY : txios(duration)
93      IMPLICIT NONE
94      TYPE(txios(duration)), INTENT(IN) :: timestep
95      TYPE(txios(calendar_wrapper))     :: calendar_wrapper
96
97      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
98
99      CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep)
100
101      CALL xios(update_calendar_timestep)(calendar_wrapper)
102   END SUBROUTINE xios(set_timestep)
103
104   SUBROUTINE xios(get_timestep)(timestep)
105      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
106      USE icalendar_wrapper_attr, ONLY : xios(get_calendar_wrapper_attr_hdl)
107      USE IDURATION, ONLY : txios(duration)
108      IMPLICIT NONE
109      TYPE(txios(duration)), INTENT(OUT) :: timestep
110      TYPE(txios(calendar_wrapper))      :: calendar_wrapper
111
112      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
113
114      CALL xios(get_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep)
115   END SUBROUTINE xios(get_timestep)
116
117   SUBROUTINE xios(set_start_date_date)(start_date)
118      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
119      USE IDATE, ONLY : txios(date)
120      IMPLICIT NONE
121      TYPE(txios(date)), INTENT(IN) :: start_date
122      TYPE(txios(calendar_wrapper)) :: calendar_wrapper
123
124      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
125
126      CALL xios(set_start_date_hdl)(calendar_wrapper, start_date)
127   END SUBROUTINE xios(set_start_date_date)
128
129   SUBROUTINE xios(set_start_date_dur)(start_date)
130      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
131      USE IDURATION, ONLY : txios(duration)
132      USE IDATE, ONLY : txios(date)
133      IMPLICIT NONE
134      TYPE(txios(duration)), INTENT(IN) :: start_date
135      TYPE(txios(calendar_wrapper))     :: calendar_wrapper
136      TYPE(txios(date))                 :: start_date_date
137
138      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
139
140      start_date_date = start_date
141      CALL xios(set_start_date_hdl)(calendar_wrapper, start_date_date)
142   END SUBROUTINE xios(set_start_date_dur)
143
144   SUBROUTINE xios(get_start_date)(start_date)
145      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
146      USE IDATE, ONLY : txios(date)
147      IMPLICIT NONE
148      TYPE(txios(date)), INTENT(OUT) :: start_date
149      TYPE(txios(calendar_wrapper))  :: calendar_wrapper
150
151      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
152
153      CALL xios(get_start_date_hdl)(calendar_wrapper, start_date)
154   END SUBROUTINE xios(get_start_date)
155
156   SUBROUTINE xios(set_time_origin_date)(time_origin)
157      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
158      USE IDATE, ONLY : txios(date)
159      IMPLICIT NONE
160      TYPE(txios(date)), INTENT(IN) :: time_origin
161      TYPE(txios(calendar_wrapper)) :: calendar_wrapper
162
163      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
164
165      CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin)
166   END SUBROUTINE xios(set_time_origin_date)
167
168   SUBROUTINE xios(set_time_origin_dur)(time_origin)
169      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
170      USE IDURATION, ONLY : txios(duration)
171      USE IDATE, ONLY : txios(date)
172      IMPLICIT NONE
173      TYPE(txios(duration)), INTENT(IN) :: time_origin
174      TYPE(txios(calendar_wrapper))     :: calendar_wrapper
175      TYPE(txios(date))                 :: time_origin_date
176
177      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
178
179      time_origin_date = time_origin
180      CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin_date)
181   END SUBROUTINE xios(set_time_origin_dur)
182
183   SUBROUTINE xios(get_time_origin)(time_origin)
184      USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle)
185      USE IDATE, ONLY : txios(date)
186      IMPLICIT NONE
187      TYPE(txios(date)), INTENT(OUT) :: time_origin
188      TYPE(txios(calendar_wrapper))  :: calendar_wrapper
189
190      CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper)
191
192      CALL xios(get_time_origin_hdl)(calendar_wrapper, time_origin)
193   END SUBROUTINE xios(get_time_origin)
194
195   SUBROUTINE xios(update_calendar)(step)
196      IMPLICIT NONE
197      INTEGER, INTENT(IN) :: step
198
199      IF (step < 0) THEN
200         PRINT *, "L'argument 'step' ne peut être négatif"
201         STOP
202      END IF
203      CALL cxios_update_calendar(step)
204   END SUBROUTINE xios(update_calendar)
205
206   SUBROUTINE xios(get_current_date)(current_date)
207      USE IDATE, ONLY : txios(date)
208      IMPLICIT NONE
209      TYPE(txios(date)), INTENT(OUT) :: current_date
210
211      CALL cxios_get_current_date(current_date)
212   END SUBROUTINE xios(get_current_date)
213
214   FUNCTION xios(get_year_length_in_seconds)(year) RESULT(res)
215      IMPLICIT NONE
216      INTEGER(kind = C_INT), INTENT(IN) :: year
217      INTEGER(kind = C_INT) :: res
218
219      res = cxios_get_year_length_in_seconds(year)
220   END FUNCTION xios(get_year_length_in_seconds)
221
222   FUNCTION xios(get_day_length_in_seconds)() RESULT(res)
223      IMPLICIT NONE
224      INTEGER(kind = C_INT) :: res
225
226      res = cxios_get_day_length_in_seconds()
227   END FUNCTION xios(get_day_length_in_seconds)
228
229END MODULE ICALENDAR
Note: See TracBrowser for help on using the repository browser.