Changeset 549 for XIOS/trunk/src/interface/fortran/icalendar.F90
- Timestamp:
- 01/26/15 14:39:26 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
XIOS/trunk/src/interface/fortran/icalendar.F90
r545 r549 3 3 USE, INTRINSIC :: ISO_C_BINDING 4 4 USE CALENDAR_INTERFACE 5 USE ICALENDAR_WRAPPER 5 6 USE IDATE 6 7 USE IDURATION … … 9 10 INTEGER(kind = C_INT), PARAMETER :: D360 = 0 , ALLLEAP = 1 , NOLEAP = 2 , JULIAN = 3 , GREGORIAN = 4 10 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 11 20 CONTAINS ! Fonctions disponibles pour les utilisateurs. 12 21 13 SUBROUTINE xios(set_calendar)(calendar_type, start_date, time_origin, timestep) 14 USE ICONTEXT, ONLY : txios(context), xios(get_current_context) 15 USE icontext_attr, ONLY : xios(set_context_attr_hdl) 16 USE IDATE, ONLY : txios(date) 17 USE IDURATION, ONLY : txios(duration) 18 IMPLICIT NONE 19 CHARACTER(len = *), OPTIONAL, INTENT(IN) :: calendar_type 22 SUBROUTINE xios(define_calendar)(type, timestep, start_date, time_origin) 23 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 24 USE icalendar_wrapper_attr, ONLY : xios(set_calendar_wrapper_attr_hdl) 25 USE IDURATION, ONLY : txios(duration) 26 USE IDATE, ONLY : txios(date) 27 IMPLICIT NONE 28 CHARACTER(len = *), INTENT(IN) :: type 29 TYPE(txios(duration)), OPTIONAL, INTENT(IN) :: timestep 20 30 TYPE(txios(date)), OPTIONAL, INTENT(IN) :: start_date 21 31 TYPE(txios(date)), OPTIONAL, INTENT(IN) :: time_origin 22 TYPE(txios(duration)), OPTIONAL, INTENT(IN) :: timestep 23 TYPE(txios(context)) :: context 24 25 CALL xios(get_current_context)(context) 26 27 IF (PRESENT(calendar_type)) THEN 28 CALL xios(set_context_attr_hdl)(context, calendar_type=calendar_type) 29 END IF 32 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 33 34 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 35 36 CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, type=type) 37 IF (PRESENT(timestep)) THEN 38 CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep) 39 END IF 40 41 CALL xios(create_calendar)(calendar_wrapper) 42 30 43 IF (PRESENT(start_date)) THEN 31 CALL xios(set_ context_attr_hdl)(context, start_date=start_date)44 CALL xios(set_start_date_hdl)(calendar_wrapper, start_date=start_date) 32 45 END IF 33 46 IF (PRESENT(time_origin)) THEN 34 CALL xios(set_context_attr_hdl)(context, time_origin=time_origin) 35 END IF 36 IF (PRESENT(time_origin)) THEN 37 CALL xios(set_context_attr_hdl)(context, timestep=timestep) 38 END IF 39 40 CALL cxios_create_calendar() 41 END SUBROUTINE xios(set_calendar) 47 CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin=time_origin) 48 END IF 49 END SUBROUTINE xios(define_calendar) 50 51 SUBROUTINE xios(get_calendar_type)(calendar_type) 52 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 53 USE icalendar_wrapper_attr, ONLY : xios(get_calendar_wrapper_attr_hdl) 54 IMPLICIT NONE 55 CHARACTER(len = *), INTENT(OUT) :: calendar_type 56 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 57 58 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 59 60 CALL xios(get_calendar_wrapper_attr_hdl)(calendar_wrapper, type=calendar_type) 61 END SUBROUTINE xios(get_calendar_type) 42 62 43 63 SUBROUTINE xios(set_timestep)(timestep) 44 USE IC ONTEXT, ONLY : txios(context), xios(get_current_context)45 USE ic ontext_attr, ONLY : xios(set_context_attr_hdl)64 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 65 USE icalendar_wrapper_attr, ONLY : xios(set_calendar_wrapper_attr_hdl) 46 66 USE IDURATION, ONLY : txios(duration) 47 67 IMPLICIT NONE 48 68 TYPE(txios(duration)), INTENT(IN) :: timestep 49 TYPE(txios(context)) :: context 50 51 CALL xios(get_current_context)(context) 52 53 CALL xios(set_context_attr_hdl)(context, timestep=timestep) 69 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 70 71 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 72 73 CALL xios(set_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep) 74 75 CALL xios(update_calendar_timestep)(calendar_wrapper) 54 76 END SUBROUTINE xios(set_timestep) 55 77 78 SUBROUTINE xios(get_timestep)(timestep) 79 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 80 USE icalendar_wrapper_attr, ONLY : xios(get_calendar_wrapper_attr_hdl) 81 USE IDURATION, ONLY : txios(duration) 82 IMPLICIT NONE 83 TYPE(txios(duration)), INTENT(OUT) :: timestep 84 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 85 86 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 87 88 CALL xios(get_calendar_wrapper_attr_hdl)(calendar_wrapper, timestep=timestep) 89 END SUBROUTINE xios(get_timestep) 90 91 SUBROUTINE xios(set_start_date_date)(start_date) 92 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 93 USE IDATE, ONLY : txios(date) 94 IMPLICIT NONE 95 TYPE(txios(date)), INTENT(IN) :: start_date 96 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 97 98 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 99 100 CALL xios(set_start_date_hdl)(calendar_wrapper, start_date) 101 END SUBROUTINE xios(set_start_date_date) 102 103 SUBROUTINE xios(set_start_date_dur)(start_date) 104 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 105 USE IDURATION, ONLY : txios(duration) 106 USE IDATE, ONLY : txios(date) 107 IMPLICIT NONE 108 TYPE(txios(duration)), INTENT(IN) :: start_date 109 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 110 TYPE(txios(date)) :: start_date_date 111 112 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 113 114 start_date_date = start_date 115 CALL xios(set_start_date_hdl)(calendar_wrapper, start_date_date) 116 END SUBROUTINE xios(set_start_date_dur) 117 118 SUBROUTINE xios(get_start_date)(start_date) 119 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 120 USE IDATE, ONLY : txios(date) 121 IMPLICIT NONE 122 TYPE(txios(date)), INTENT(OUT) :: start_date 123 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 124 125 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 126 127 CALL xios(get_start_date_hdl)(calendar_wrapper, start_date) 128 END SUBROUTINE xios(get_start_date) 129 130 SUBROUTINE xios(set_time_origin_date)(time_origin) 131 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 132 USE IDATE, ONLY : txios(date) 133 IMPLICIT NONE 134 TYPE(txios(date)), INTENT(IN) :: time_origin 135 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 136 137 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 138 139 CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin) 140 END SUBROUTINE xios(set_time_origin_date) 141 142 SUBROUTINE xios(set_time_origin_dur)(time_origin) 143 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 144 USE IDURATION, ONLY : txios(duration) 145 USE IDATE, ONLY : txios(date) 146 IMPLICIT NONE 147 TYPE(txios(duration)), INTENT(IN) :: time_origin 148 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 149 TYPE(txios(date)) :: time_origin_date 150 151 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 152 153 time_origin_date = time_origin 154 CALL xios(set_time_origin_hdl)(calendar_wrapper, time_origin_date) 155 END SUBROUTINE xios(set_time_origin_dur) 156 157 SUBROUTINE xios(get_time_origin)(time_origin) 158 USE ICALENDAR_WRAPPER, ONLY : txios(calendar_wrapper), xios(get_default_calendar_wrapper_handle) 159 USE IDATE, ONLY : txios(date) 160 IMPLICIT NONE 161 TYPE(txios(date)), INTENT(OUT) :: time_origin 162 TYPE(txios(calendar_wrapper)) :: calendar_wrapper 163 164 CALL xios(get_default_calendar_wrapper_handle)(calendar_wrapper) 165 166 CALL xios(get_time_origin_hdl)(calendar_wrapper, time_origin) 167 END SUBROUTINE xios(get_time_origin) 168 56 169 SUBROUTINE xios(update_calendar)(step) 57 170 IMPLICIT NONE 58 171 INTEGER, INTENT(IN) :: step 59 172 60 173 IF (step < 0) THEN 61 174 PRINT *, "L'argument 'step' ne peut être négatif" … … 65 178 END SUBROUTINE xios(update_calendar) 66 179 180 SUBROUTINE xios(get_current_date)(current_date) 181 USE IDATE, ONLY : txios(date) 182 IMPLICIT NONE 183 TYPE(txios(date)), INTENT(OUT) :: current_date 184 185 CALL cxios_get_current_date(current_date) 186 END SUBROUTINE xios(get_current_date) 187 188 FUNCTION xios(get_year_length_in_seconds)(year) RESULT(res) 189 IMPLICIT NONE 190 INTEGER(kind = C_INT), INTENT(IN) :: year 191 INTEGER(kind = C_INT) :: res 192 193 res = cxios_get_year_length_in_seconds(year) 194 END FUNCTION xios(get_year_length_in_seconds) 195 196 FUNCTION xios(get_day_length_in_seconds)() RESULT(res) 197 IMPLICIT NONE 198 INTEGER(kind = C_INT) :: res 199 200 res = cxios_get_day_length_in_seconds() 201 END FUNCTION xios(get_day_length_in_seconds) 202 67 203 END MODULE ICALENDAR
Note: See TracChangeset
for help on using the changeset viewer.