[325] | 1 | #include "xios_fortran_prefix.hpp" |
---|
| 2 | MODULE IDATE |
---|
| 3 | USE, INTRINSIC :: ISO_C_BINDING |
---|
[545] | 4 | USE DATE_INTERFACE |
---|
[2620] | 5 | USE LOGICAL_BOOL_CONVERSION |
---|
[325] | 6 | |
---|
[545] | 7 | INTERFACE OPERATOR(+) |
---|
| 8 | MODULE PROCEDURE xios(date_add_duration) |
---|
| 9 | END INTERFACE |
---|
[325] | 10 | |
---|
[545] | 11 | INTERFACE OPERATOR(-) |
---|
| 12 | MODULE PROCEDURE xios(date_sub_duration) |
---|
| 13 | MODULE PROCEDURE xios(date_sub) |
---|
| 14 | END INTERFACE |
---|
[325] | 15 | |
---|
[545] | 16 | INTERFACE OPERATOR(==) |
---|
| 17 | MODULE PROCEDURE xios(date_eq) |
---|
| 18 | END INTERFACE |
---|
[325] | 19 | |
---|
[545] | 20 | INTERFACE OPERATOR(/=) |
---|
| 21 | MODULE PROCEDURE xios(date_neq) |
---|
| 22 | END INTERFACE |
---|
[325] | 23 | |
---|
[545] | 24 | INTERFACE OPERATOR(<) |
---|
| 25 | MODULE PROCEDURE xios(date_lt) |
---|
| 26 | END INTERFACE |
---|
[537] | 27 | |
---|
[545] | 28 | INTERFACE OPERATOR(<=) |
---|
| 29 | MODULE PROCEDURE xios(date_le) |
---|
[325] | 30 | END INTERFACE |
---|
[545] | 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 | |
---|
[549] | 40 | INTERFACE ASSIGNMENT(=) |
---|
| 41 | MODULE PROCEDURE xios(date_assign_duration) |
---|
| 42 | END INTERFACE |
---|
| 43 | |
---|
[325] | 44 | CONTAINS ! Fonctions disponibles pour les utilisateurs. |
---|
| 45 | |
---|
[794] | 46 | ! Conversion functions |
---|
| 47 | |
---|
[545] | 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 |
---|
[325] | 53 | |
---|
[545] | 54 | res = cxios_date_convert_to_seconds(date) |
---|
| 55 | END FUNCTION xios(date_convert_to_seconds) |
---|
| 56 | |
---|
[794] | 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 | |
---|
[801] | 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 | |
---|
[545] | 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 |
---|
[2620] | 118 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 119 | |
---|
[2620] | 120 | res__tmp = cxios_date_eq(date1, date2) |
---|
| 121 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 122 | res = res__tmp |
---|
[545] | 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 |
---|
[2620] | 130 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 131 | |
---|
[2620] | 132 | res__tmp = cxios_date_neq(date1, date2) |
---|
| 133 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 134 | res = res__tmp |
---|
[545] | 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 |
---|
[2620] | 142 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 143 | |
---|
[2620] | 144 | res__tmp = cxios_date_lt(date1, date2) |
---|
| 145 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 146 | res = res__tmp |
---|
[545] | 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 |
---|
[2620] | 154 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 155 | |
---|
[2620] | 156 | res__tmp = cxios_date_le(date1, date2) |
---|
| 157 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 158 | res = res__tmp |
---|
[545] | 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 |
---|
[2620] | 166 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 167 | |
---|
[2620] | 168 | res__tmp = cxios_date_gt(date1, date2) |
---|
| 169 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 170 | res = res__tmp |
---|
[545] | 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 |
---|
[2620] | 178 | LOGICAL (KIND=C_BOOL) :: res__tmp |
---|
[545] | 179 | |
---|
[2620] | 180 | res__tmp = cxios_date_ge(date1, date2) |
---|
| 181 | CALL xios_bool_to_logical_0d(res__tmp) |
---|
| 182 | res = res__tmp |
---|
[545] | 183 | END FUNCTION xios(date_ge) |
---|
| 184 | |
---|
[549] | 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 |
---|
[558] | 198 | TYPE(txios(date)), INTENT(IN) :: date |
---|
[549] | 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 |
---|
[558] | 207 | TYPE(txios(date)), INTENT(IN) :: date |
---|
[549] | 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 |
---|
[558] | 216 | TYPE(txios(date)), INTENT(IN) :: date |
---|
[549] | 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 |
---|
[558] | 225 | TYPE(txios(date)), INTENT(IN) :: date |
---|
[549] | 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 |
---|
[558] | 234 | TYPE(txios(date)), INTENT(IN) :: date |
---|
[549] | 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 | |
---|
[325] | 240 | END MODULE IDATE |
---|