source: XIOS3/trunk/src/interface/fortran/idate.F90 @ 2634

Last change on this file since 2634 was 2620, checked in by jderouillat, 4 months ago

Modify fortran-C interfaces to manage logical-bool conversion, the optimizations of OneAPI could produce bugs regarding the logical-bool encodings.
  • Property copyright set to
    Software name : XIOS (Xml I/O Server)
    http://forge.ipsl.jussieu.fr/ioserver
    Creation date : January 2009
    Licence : CeCCIL version2
    see license file in root directory : Licence_CeCILL_V2-en.txt
    or http://www.cecill.info/licences/Licence_CeCILL_V2-en.html
    Holder : CEA/LSCE (Laboratoire des Sciences du CLimat et de l'Environnement)
    CNRS/IPSL (Institut Pierre Simon Laplace)
    Project Manager : Yann Meurdesoif
    yann.meurdesoif@cea.fr
File size: 7.1 KB
Line 
1#include "xios_fortran_prefix.hpp"
2MODULE IDATE
3   USE, INTRINSIC :: ISO_C_BINDING
4   USE DATE_INTERFACE
5   USE LOGICAL_BOOL_CONVERSION
6
7   INTERFACE OPERATOR(+)
8      MODULE PROCEDURE xios(date_add_duration)
9   END INTERFACE
10
11   INTERFACE OPERATOR(-)
12      MODULE PROCEDURE xios(date_sub_duration)
13      MODULE PROCEDURE xios(date_sub)
14   END INTERFACE
15
16   INTERFACE OPERATOR(==)
17      MODULE PROCEDURE xios(date_eq)
18   END INTERFACE
19
20   INTERFACE OPERATOR(/=)
21      MODULE PROCEDURE xios(date_neq)
22   END INTERFACE
23
24   INTERFACE OPERATOR(<)
25      MODULE PROCEDURE xios(date_lt)
26   END INTERFACE
27
28   INTERFACE OPERATOR(<=)
29      MODULE PROCEDURE xios(date_le)
30   END INTERFACE
31
32   INTERFACE OPERATOR(>)
33      MODULE PROCEDURE xios(date_gt)
34   END INTERFACE
35
36   INTERFACE OPERATOR(>=)
37      MODULE PROCEDURE xios(date_ge)
38   END INTERFACE
39
40   INTERFACE ASSIGNMENT(=)
41      MODULE PROCEDURE xios(date_assign_duration)
42   END INTERFACE
43
44   CONTAINS ! Fonctions disponibles pour les utilisateurs.
45
46   ! Conversion functions
47
48   FUNCTION xios(date_convert_to_seconds)(date) RESULT(res)
49      USE DATE_INTERFACE, only : txios(date)
50      IMPLICIT NONE
51      TYPE(txios(date)), INTENT(IN) :: date
52      INTEGER(kind = C_LONG_LONG) :: res
53
54      res = cxios_date_convert_to_seconds(date)
55   END FUNCTION xios(date_convert_to_seconds)
56
57   SUBROUTINE xios(date_convert_to_string)(date, str)
58      USE DATE_INTERFACE, only : txios(date)
59      IMPLICIT NONE
60      TYPE(txios(date)), INTENT(IN) :: date
61      CHARACTER(len = *), INTENT(OUT) :: str
62
63      CALL cxios_date_convert_to_string(date, str, len(str))
64   END SUBROUTINE xios(date_convert_to_string)
65
66   FUNCTION xios(date_convert_from_string)(str) RESULT(res)
67      USE DATE_INTERFACE, only : txios(date)
68      IMPLICIT NONE
69      CHARACTER(len = *), INTENT(IN) :: str
70      TYPE(txios(date)) :: res
71
72      res = cxios_date_convert_from_string(str, len(str))
73   END FUNCTION xios(date_convert_from_string)
74
75   ! Addition: date + duration = date
76
77   FUNCTION xios(date_add_duration)(date, dur) RESULT(res)
78      USE DATE_INTERFACE, only : txios(date)
79      USE IDURATION, only : txios(duration)
80      IMPLICIT NONE
81      TYPE(txios(date)), INTENT(IN) :: date
82      TYPE(txios(duration)), INTENT(IN) :: dur
83      TYPE(txios(date)) :: res
84
85      res = cxios_date_add_duration(date, dur)
86   END FUNCTION xios(date_add_duration)
87
88   ! Subtraction: date - duration = date
89
90   FUNCTION xios(date_sub_duration)(date, dur) RESULT(res)
91      USE DATE_INTERFACE, only : txios(date)
92      USE IDURATION, only : txios(duration)
93      IMPLICIT NONE
94      TYPE(txios(date)), INTENT(IN) :: date
95      TYPE(txios(duration)), INTENT(IN) :: dur
96      TYPE(txios(date)) :: res
97
98      res = cxios_date_sub_duration(date, dur)
99   END FUNCTION xios(date_sub_duration)
100
101   ! Subtraction: date - date = duration
102
103   FUNCTION xios(date_sub)(date1, date2) RESULT(res)
104      USE DATE_INTERFACE, only : txios(date)
105      USE IDURATION, only : txios(duration)
106      IMPLICIT NONE
107      TYPE(txios(date)), INTENT(IN) :: date1, date2
108      TYPE(txios(duration)) :: res
109
110      res = cxios_date_sub(date1, date2)
111   END FUNCTION xios(date_sub)
112
113   FUNCTION xios(date_eq)(date1, date2) RESULT(res)
114      USE DATE_INTERFACE, only : txios(date)
115      IMPLICIT NONE
116      TYPE(txios(date)), INTENT(IN) :: date1, date2
117      LOGICAL :: res
118      LOGICAL (KIND=C_BOOL) :: res__tmp
119
120      res__tmp = cxios_date_eq(date1, date2)
121      CALL xios_bool_to_logical_0d(res__tmp)
122      res = res__tmp
123   END FUNCTION xios(date_eq)
124
125   FUNCTION xios(date_neq)(date1, date2) RESULT(res)
126      USE DATE_INTERFACE, only : txios(date)
127      IMPLICIT NONE
128      TYPE(txios(date)), INTENT(IN) :: date1, date2
129      LOGICAL :: res
130      LOGICAL (KIND=C_BOOL) :: res__tmp
131
132      res__tmp = cxios_date_neq(date1, date2)
133      CALL xios_bool_to_logical_0d(res__tmp)
134      res = res__tmp
135   END FUNCTION xios(date_neq)
136
137   FUNCTION xios(date_lt)(date1, date2) RESULT(res)
138      USE DATE_INTERFACE, only : txios(date)
139      IMPLICIT NONE
140      TYPE(txios(date)), INTENT(IN) :: date1, date2
141      LOGICAL :: res
142      LOGICAL (KIND=C_BOOL) :: res__tmp
143
144      res__tmp = cxios_date_lt(date1, date2)
145      CALL xios_bool_to_logical_0d(res__tmp)
146      res = res__tmp
147   END FUNCTION xios(date_lt)
148
149   FUNCTION xios(date_le)(date1, date2) RESULT(res)
150      USE DATE_INTERFACE, only : txios(date)
151      IMPLICIT NONE
152      TYPE(txios(date)), INTENT(IN) :: date1, date2
153      LOGICAL :: res
154      LOGICAL (KIND=C_BOOL) :: res__tmp
155
156      res__tmp = cxios_date_le(date1, date2)
157      CALL xios_bool_to_logical_0d(res__tmp)
158      res = res__tmp
159   END FUNCTION xios(date_le)
160
161   FUNCTION xios(date_gt)(date1, date2) RESULT(res)
162      USE DATE_INTERFACE, only : txios(date)
163      IMPLICIT NONE
164      TYPE(txios(date)), INTENT(IN) :: date1, date2
165      LOGICAL :: res
166      LOGICAL (KIND=C_BOOL) :: res__tmp
167
168      res__tmp = cxios_date_gt(date1, date2)
169      CALL xios_bool_to_logical_0d(res__tmp)
170      res = res__tmp
171   END FUNCTION xios(date_gt)
172
173   FUNCTION xios(date_ge)(date1, date2) RESULT(res)
174      USE DATE_INTERFACE, only : txios(date)
175      IMPLICIT NONE
176      TYPE(txios(date)), INTENT(IN) :: date1, date2
177      LOGICAL :: res
178      LOGICAL (KIND=C_BOOL) :: res__tmp
179
180      res__tmp = cxios_date_ge(date1, date2)
181      CALL xios_bool_to_logical_0d(res__tmp)
182      res = res__tmp
183   END FUNCTION xios(date_ge)
184
185   SUBROUTINE xios(date_assign_duration)(date, dur)
186      USE DATE_INTERFACE, only : txios(date)
187      USE IDURATION, only : txios(duration)
188      IMPLICIT NONE
189      TYPE(txios(date)), INTENT(OUT) :: date
190      TYPE(txios(duration)), INTENT(IN) :: dur
191
192      date = txios(date)(0, 1, 1, 0, 0, 0) + dur
193   END SUBROUTINE xios(date_assign_duration)
194
195   FUNCTION xios(date_get_second_of_year)(date) RESULT(res)
196      USE DATE_INTERFACE, only : txios(date)
197      IMPLICIT NONE
198      TYPE(txios(date)), INTENT(IN) :: date
199      INTEGER(kind = C_INT) :: res
200
201      res = cxios_date_get_second_of_year(date)
202   END FUNCTION xios(date_get_second_of_year)
203
204   FUNCTION xios(date_get_day_of_year)(date) RESULT(res)
205      USE DATE_INTERFACE, only : txios(date)
206      IMPLICIT NONE
207      TYPE(txios(date)), INTENT(IN) :: date
208      REAL(kind = C_DOUBLE) :: res
209
210      res = cxios_date_get_day_of_year(date)
211   END FUNCTION xios(date_get_day_of_year)
212
213   FUNCTION xios(date_get_fraction_of_year)(date) RESULT(res)
214      USE DATE_INTERFACE, only : txios(date)
215      IMPLICIT NONE
216      TYPE(txios(date)), INTENT(IN) :: date
217      REAL(kind = C_DOUBLE) :: res
218
219      res = cxios_date_get_fraction_of_year(date)
220   END FUNCTION xios(date_get_fraction_of_year)
221
222   FUNCTION xios(date_get_second_of_day)(date) RESULT(res)
223      USE DATE_INTERFACE, only : txios(date)
224      IMPLICIT NONE
225      TYPE(txios(date)), INTENT(IN) :: date
226      INTEGER(kind = C_INT) :: res
227
228      res = cxios_date_get_second_of_day(date)
229   END FUNCTION xios(date_get_second_of_day)
230
231   FUNCTION xios(date_get_fraction_of_day)(date) RESULT(res)
232      USE DATE_INTERFACE, only : txios(date)
233      IMPLICIT NONE
234      TYPE(txios(date)), INTENT(IN) :: date
235      REAL(kind = C_DOUBLE) :: res
236
237      res = cxios_date_get_fraction_of_day(date)
238   END FUNCTION xios(date_get_fraction_of_day)
239
240END MODULE IDATE
Note: See TracBrowser for help on using the repository browser.