source: XIOS3/trunk/src/interface/fortran/iduration.F90 @ 2620

Last change on this file since 2620 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.
File size: 6.4 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IDURATION
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE DURATION_INTERFACE
6   USE LOGICAL_BOOL_CONVERSION
7
8   TYPE(txios(duration)), PARAMETER :: xios(year) = txios(duration)(1, 0, 0, 0, 0, 0, 0)
9   TYPE(txios(duration)), PARAMETER :: xios(month) = txios(duration)(0, 1, 0, 0, 0, 0, 0)
10   TYPE(txios(duration)), PARAMETER :: xios(day) = txios(duration)(0, 0, 1, 0, 0, 0, 0)
11   TYPE(txios(duration)), PARAMETER :: xios(hour) = txios(duration)(0, 0, 0, 1, 0, 0, 0)
12   TYPE(txios(duration)), PARAMETER :: xios(minute) = txios(duration)(0, 0, 0, 0, 1, 0, 0)
13   TYPE(txios(duration)), PARAMETER :: xios(second) = txios(duration)(0, 0, 0, 0, 0, 1, 0)
14   TYPE(txios(duration)), PARAMETER :: xios(timestep) = txios(duration)(0, 0, 0, 0, 0, 0, 1)
15
16   INTERFACE OPERATOR(+)
17      MODULE PROCEDURE xios(duration_add)
18   END INTERFACE
19
20   INTERFACE OPERATOR(-)
21      MODULE PROCEDURE xios(duration_sub)
22      MODULE PROCEDURE xios(duration_neg)
23   END INTERFACE
24
25   INTERFACE OPERATOR(*)
26      MODULE PROCEDURE xios(real4_duration_mult)
27      MODULE PROCEDURE xios(duration_real4_mult)
28      MODULE PROCEDURE xios(real8_duration_mult)
29      MODULE PROCEDURE xios(duration_real8_mult)
30      MODULE PROCEDURE xios(int_duration_mult)
31      MODULE PROCEDURE xios(duration_int_mult)
32   END INTERFACE
33
34   INTERFACE xios(duration_mult)
35      MODULE PROCEDURE xios(real4_duration_mult)
36      MODULE PROCEDURE xios(duration_real4_mult)
37      MODULE PROCEDURE xios(real8_duration_mult)
38      MODULE PROCEDURE xios(duration_real8_mult)
39      MODULE PROCEDURE xios(int_duration_mult)
40      MODULE PROCEDURE xios(duration_int_mult)
41   END INTERFACE
42
43   INTERFACE OPERATOR(==)
44      MODULE PROCEDURE xios(duration_eq)
45   END INTERFACE
46
47   INTERFACE OPERATOR(/=)
48      MODULE PROCEDURE xios(duration_neq)
49   END INTERFACE
50
51   CONTAINS
52
53   ! Conversion function
54
55   SUBROUTINE xios(duration_convert_to_string)(dur, str)
56      USE DURATION_INTERFACE, only : txios(duration)
57      IMPLICIT NONE
58      TYPE(txios(duration)), INTENT(IN) :: dur
59      CHARACTER(len = *), INTENT(OUT) :: str
60
61      CALL cxios_duration_convert_to_string(dur, str, len(str))
62   END SUBROUTINE xios(duration_convert_to_string)
63
64   FUNCTION xios(duration_convert_from_string)(str) RESULT(res)
65      USE DURATION_INTERFACE, only : txios(duration)
66      IMPLICIT NONE
67      CHARACTER(len = *), INTENT(IN) :: str
68      TYPE(txios(duration)) :: res
69
70      res = cxios_duration_convert_from_string(str, len(str))
71   END FUNCTION xios(duration_convert_from_string)
72
73   ! Addition
74
75   FUNCTION xios(duration_add)(dur1, dur2) RESULT(res)
76      USE DURATION_INTERFACE, only : txios(duration)
77      IMPLICIT NONE
78      TYPE(txios(duration)), INTENT(IN) :: dur1, dur2
79      TYPE(txios(duration)) :: res
80
81      res = cxios_duration_add(dur1, dur2)
82   END FUNCTION xios(duration_add)
83
84   ! Subtraction
85
86   FUNCTION xios(duration_sub)(dur1, dur2) RESULT(res)
87      USE DURATION_INTERFACE, only : txios(duration)
88      IMPLICIT NONE
89      TYPE(txios(duration)), INTENT(IN) :: dur1, dur2
90      TYPE(txios(duration)) :: res
91
92      res = cxios_duration_sub(dur1, dur2)
93   END FUNCTION xios(duration_sub)
94
95   ! Multiplication by a scalar
96   
97   FUNCTION xios(real4_duration_mult)(val, dur) RESULT(res)
98      USE ISO_C_BINDING
99      USE DURATION_INTERFACE, only : txios(duration)
100      IMPLICIT NONE
101      REAL(kind = C_FLOAT), INTENT(IN) :: val
102      TYPE(txios(duration)), INTENT(IN) :: dur
103      TYPE(txios(duration)) :: res
104
105      res = cxios_duration_mult(REAL(val, C_DOUBLE), dur)
106   END FUNCTION xios(real4_duration_mult)
107   
108   FUNCTION xios(duration_real4_mult)(dur, val2) RESULT(res)
109      USE ISO_C_BINDING
110      USE DURATION_INTERFACE, only : txios(duration)
111      IMPLICIT NONE
112      TYPE(txios(duration)), INTENT(IN) :: dur
113      REAL(kind = C_FLOAT), INTENT(IN) :: val2
114      TYPE(txios(duration)) :: res
115
116      res = cxios_duration_mult(REAL(val2, C_DOUBLE), dur)
117   END FUNCTION xios(duration_real4_mult)
118   
119   FUNCTION xios(real8_duration_mult)(val, dur) RESULT(res)
120      USE ISO_C_BINDING
121      USE DURATION_INTERFACE, only : txios(duration)
122      IMPLICIT NONE
123      REAL(kind = C_DOUBLE), INTENT(IN) :: val
124      TYPE(txios(duration)), INTENT(IN) :: dur
125      TYPE(txios(duration)) :: res
126
127      res = cxios_duration_mult(val, dur)
128   END FUNCTION xios(real8_duration_mult)
129   
130   FUNCTION xios(duration_real8_mult)(dur, val2) RESULT(res)
131      USE ISO_C_BINDING
132      USE DURATION_INTERFACE, only : txios(duration)
133      IMPLICIT NONE
134      TYPE(txios(duration)), INTENT(IN) :: dur
135      REAL(kind = C_DOUBLE), INTENT(IN) :: val2
136      TYPE(txios(duration)) :: res
137
138      res = cxios_duration_mult(val2, dur)
139   END FUNCTION xios(duration_real8_mult)
140   
141   FUNCTION xios(int_duration_mult)(val, dur) RESULT(res)
142      USE ISO_C_BINDING
143      USE DURATION_INTERFACE, only : txios(duration)
144      IMPLICIT NONE
145      INTEGER, INTENT(IN) :: val
146      TYPE(txios(duration)), INTENT(IN) :: dur
147      TYPE(txios(duration)) :: res
148
149      res = cxios_duration_mult(REAL(val, C_DOUBLE), dur)
150   END FUNCTION xios(int_duration_mult)
151   
152   FUNCTION xios(duration_int_mult)(dur, val2) RESULT(res)
153      USE ISO_C_BINDING
154      USE DURATION_INTERFACE, only : txios(duration)
155      IMPLICIT NONE
156      TYPE(txios(duration)), INTENT(IN) :: dur
157      INTEGER, INTENT(IN) :: val2
158      TYPE(txios(duration)) :: res
159
160      res = cxios_duration_mult(REAL(val2, C_DOUBLE), dur)
161   END FUNCTION xios(duration_int_mult)
162
163   ! Negation
164
165   FUNCTION xios(duration_neg)(dur) RESULT(res)
166      USE DURATION_INTERFACE, only : txios(duration)
167      IMPLICIT NONE
168      TYPE(txios(duration)), INTENT(IN) :: dur
169      TYPE(txios(duration)) :: res
170
171      res = cxios_duration_neg(dur)
172   END FUNCTION xios(duration_neg)
173
174   FUNCTION xios(duration_eq)(dur1, dur2) RESULT(res)
175      USE duration_INTERFACE, only : txios(duration)
176      IMPLICIT NONE
177      TYPE(txios(duration)), INTENT(IN) :: dur1, dur2
178      LOGICAL :: res
179      LOGICAL (KIND=C_BOOL) :: res__tmp
180
181      res__tmp = cxios_duration_eq(dur1, dur2)
182      CALL xios_bool_to_logical_0d(res__tmp)
183      res = res__tmp
184   END FUNCTION xios(duration_eq)
185
186   FUNCTION xios(duration_neq)(dur1, dur2) RESULT(res)
187      USE duration_INTERFACE, only : txios(duration)
188      IMPLICIT NONE
189      TYPE(txios(duration)), INTENT(IN) :: dur1, dur2
190      LOGICAL :: res
191      LOGICAL (KIND=C_BOOL) :: res__tmp
192
193      res__tmp = cxios_duration_neq(dur1, dur2)
194      CALL xios_bool_to_logical_0d(res__tmp)
195      res = res__tmp
196   END FUNCTION xios(duration_neq)
197
198END MODULE IDURATION
Note: See TracBrowser for help on using the repository browser.