portedportable, not yet portedexecuted, not portableexecutable, not hit by this run
| 1 | ! This file is part of MOM6, the Modular Ocean Model version 6. | |
| 2 | ! See the LICENSE file for licensing information. | |
| 3 | ! SPDX-License-Identifier: Apache-2.0 | |
| 4 | ||
| 5 | !> A wrapper for the FMS diag_manager routines. This module should be the | |
| 6 | !! only MOM6 module which imports the FMS shared infrastructure for | |
| 7 | !! diagnostics. Pass through interfaces are being documented | |
| 8 | !! here and renamed in order to clearly identify these APIs as being | |
| 9 | !! consistent with the FMS infrastructure (Any future updates to | |
| 10 | !! those APIs would be applied here). | |
| 11 | module MOM_diag_manager_infra | |
| 12 | ||
| 13 | use, intrinsic :: iso_fortran_env, only : real64 | |
| 14 | use diag_axis_mod, only : fms_axis_init=>diag_axis_init | |
| 15 | use diag_axis_mod, only : fms_get_diag_axis_name => get_diag_axis_name | |
| 16 | use diag_axis_mod, only : EAST, NORTH | |
| 17 | use diag_data_mod, only : null_axis_id | |
| 18 | use diag_manager_mod, only : fms_diag_manager_init => diag_manager_init | |
| 19 | use diag_manager_mod, only : fms_diag_manager_end => diag_manager_end | |
| 20 | use diag_manager_mod, only : diag_send_complete | |
| 21 | use diag_manager_mod, only : diag_manager_set_time_end | |
| 22 | use diag_manager_mod, only : send_data_fms => send_data | |
| 23 | use diag_manager_mod, only : fms_diag_field_add_attribute => diag_field_add_attribute | |
| 24 | use diag_manager_mod, only : DIAG_FIELD_NOT_FOUND | |
| 25 | use diag_manager_mod, only : register_diag_field_fms => register_diag_field | |
| 26 | use diag_manager_mod, only : register_static_field_fms => register_static_field | |
| 27 | use diag_manager_mod, only : get_diag_field_id_fms => get_diag_field_id | |
| 28 | use MOM_time_manager, only : time_type, set_time | |
| 29 | use MOM_domain_infra, only : MOM_domain_type | |
| 30 | use MOM_error_infra, only : MOM_error => MOM_err, FATAL, WARNING | |
| 31 | ||
| 32 | implicit none ; private | |
| 33 | ||
| 34 | !> transmit data for diagnostic output | |
| 35 | interface register_diag_field_infra | |
| 36 | module procedure register_diag_field_infra_scalar | |
| 37 | module procedure register_diag_field_infra_array | |
| 38 | end interface register_diag_field_infra | |
| 39 | ||
| 40 | !> transmit data for diagnostic output | |
| 41 | interface send_data_infra | |
| 42 | module procedure send_data_infra_0d, send_data_infra_1d | |
| 43 | module procedure send_data_infra_2d, send_data_infra_3d | |
| 44 | #ifdef OVERLOAD_R8 | |
| 45 | module procedure send_data_infra_2d_r8, send_data_infra_3d_r8 | |
| 46 | #endif | |
| 47 | end interface send_data_infra | |
| 48 | ||
| 49 | !> Add an attribute to a diagnostic field | |
| 50 | interface MOM_diag_field_add_attribute | |
| 51 | module procedure MOM_diag_field_add_attribute_scalar_r | |
| 52 | module procedure MOM_diag_field_add_attribute_scalar_i | |
| 53 | module procedure MOM_diag_field_add_attribute_scalar_c | |
| 54 | module procedure MOM_diag_field_add_attribute_r1d | |
| 55 | module procedure MOM_diag_field_add_attribute_i1d | |
| 56 | end interface MOM_diag_field_add_attribute | |
| 57 | ||
| 58 | ||
| 59 | ! Public interfaces | |
| 60 | public MOM_diag_axis_init | |
| 61 | public get_MOM_diag_axis_name | |
| 62 | public MOM_diag_manager_init | |
| 63 | public MOM_diag_manager_end | |
| 64 | public send_data_infra | |
| 65 | public diag_send_complete_infra | |
| 66 | public diag_manager_set_time_end_infra | |
| 67 | public MOM_diag_field_add_attribute | |
| 68 | public register_diag_field_infra | |
| 69 | public register_static_field_infra | |
| 70 | public get_MOM_diag_field_id | |
| 71 | ! Public data | |
| 72 | public null_axis_id | |
| 73 | public DIAG_FIELD_NOT_FOUND | |
| 74 | public EAST, NORTH | |
| 75 | ||
| 76 | ||
| 77 | contains | |
| 78 | ||
| 79 | !> Initialize a diagnostic axis | |
| 80 | 13 | integer function MOM_diag_axis_init(name, data, units, cart_name, long_name, MOM_domain, position, & |
| 81 | & direction, edges, set_name, coarsen, null_axis) | |
| 82 | character(len=*), intent(in) :: name !< The name of this axis | |
| 83 | real, dimension(:), intent(in) :: data !< The array of coordinate values | |
| 84 | character(len=*), intent(in) :: units !< The units for the axis data | |
| 85 | character(len=*), intent(in) :: cart_name !< Cartesian axis ("X", "Y", "Z", "T", or "N" for none) | |
| 86 | character(len=*), & | |
| 87 | optional, intent(in) :: long_name !< The long name of this axis | |
| 88 | type(MOM_domain_type), & | |
| 89 | optional, intent(in) :: MOM_Domain !< A MOM_Domain that describes the decomposition | |
| 90 | integer, optional, intent(in) :: position !< This indicates the relative position of this | |
| 91 | !! axis. The default is CENTER, but EAST and NORTH | |
| 92 | !! are common options. | |
| 93 | integer, optional, intent(in) :: direction !< This indicates the direction along which this | |
| 94 | !! axis increases: 1 for upward, -1 for downward, or | |
| 95 | !! 0 for non-vertical axes (the default) | |
| 96 | integer, optional, intent(in) :: edges !< The axis_id of the complementary axis that | |
| 97 | !! describes the edges of this axis | |
| 98 | character(len=*), & | |
| 99 | optional, intent(in) :: set_name !< A name to use for this set of axes. | |
| 100 | integer, optional, intent(in) :: coarsen !< An optional degree of coarsening for the grid, 1 | |
| 101 | !! by default. | |
| 102 | logical, optional, intent(in) :: null_axis !< If present and true, return the special null axis | |
| 103 | !! id for use with scalars. | |
| 104 | ||
| 105 | integer :: coarsening ! The degree of grid coarsening | |
| 106 | ||
| 107 | 13 | if (present(null_axis)) then ; if (null_axis) then |
| 108 | ! Return the special null axis id for scalars | |
| 109 | 1 | MOM_diag_axis_init = null_axis_id |
| 110 | 1 | return |
| 111 | endif ; endif | |
| 112 | ||
| 113 | 12 | if (present(MOM_domain)) then |
| 114 | 8 | coarsening = 1 ; if (present(coarsen)) coarsening = coarsen |
| 115 | 8 | if (coarsening == 1) then |
| 116 | MOM_diag_axis_init = fms_axis_init(name, data, units, cart_name, long_name=long_name, & | |
| 117 | direction=direction, set_name=set_name, edges=edges, & | |
| 118 | 4 | domain2=MOM_domain%mpp_domain, domain_position=position) |
| 119 | 4 | elseif (coarsening == 2) then |
| 120 | MOM_diag_axis_init = fms_axis_init(name, data, units, cart_name, long_name=long_name, & | |
| 121 | direction=direction, set_name=set_name, edges=edges, & | |
| 122 | 4 | domain2=MOM_domain%mpp_domain_d2, domain_position=position) |
| 123 | else | |
| 124 | 0 | call MOM_error(FATAL, "diag_axis_init called with an invalid value of coarsen.") |
| 125 | endif | |
| 126 | else | |
| 127 | 4 | if (present(coarsen)) then ; if (coarsen /= 1) then |
| 128 | 0 | call MOM_error(FATAL, "diag_axis_init does not support grid coarsening without a MOM_domain.") |
| 129 | endif ; endif | |
| 130 | MOM_diag_axis_init = fms_axis_init(name, data, units, cart_name, long_name=long_name, & | |
| 131 | 4 | direction=direction, set_name=set_name, edges=edges) |
| 132 | endif | |
| 133 | ||
| 134 | 25 | end function MOM_diag_axis_init |
| 135 | ||
| 136 | !> Returns the short name of the axis | |
| 137 | 8444 | subroutine get_MOM_diag_axis_name(id, name) |
| 138 | integer, intent(in) :: id !< The axis numeric id | |
| 139 | character(len=*), intent(out) :: name !< The short name of the axis | |
| 140 | ||
| 141 | 8444 | call fms_get_diag_axis_name(id, name) |
| 142 | ||
| 143 | 8444 | end subroutine get_MOM_diag_axis_name |
| 144 | ||
| 145 | !> Return a unique numeric ID field a module/field name combination. | |
| 146 | 0 | integer function get_MOM_diag_field_id(module_name, field_name) |
| 147 | character(len=*), intent(in) :: module_name !< A module name string to query. | |
| 148 | character(len=*), intent(in) :: field_name !< A field name string to query. | |
| 149 | ||
| 150 | ||
| 151 | 0 | get_MOM_diag_field_id = -1 |
| 152 | 0 | get_MOM_diag_field_id = get_diag_field_id_fms(module_name, field_name) |
| 153 | ||
| 154 | 0 | end function get_MOM_diag_field_id |
| 155 | ||
| 156 | !> Initializes the diagnostic manager | |
| 157 | 1 | subroutine MOM_diag_manager_init(diag_model_subset, time_init, err_msg) |
| 158 | integer, optional, intent(in) :: diag_model_subset !< An optional diagnostic subset | |
| 159 | integer, dimension(6), optional, intent(in) :: time_init !< An optional reference time for diagnostics | |
| 160 | !! The default uses the value contained in the | |
| 161 | !! diag_table. Format is Y-M-D-H-M-S | |
| 162 | character(len=*), optional, intent(out) :: err_msg !< Error message. | |
| 163 | 1 | call FMS_diag_manager_init(diag_model_subset, time_init, err_msg) |
| 164 | ||
| 165 | 1 | end subroutine MOM_diag_manager_init |
| 166 | ||
| 167 | !> Close the diagnostic manager | |
| 168 | 1 | subroutine MOM_diag_manager_end(time) |
| 169 | type(time_type), intent(in) :: time !< Model time at call to close. | |
| 170 | ||
| 171 | 1 | call FMS_diag_manager_end(time) |
| 172 | ||
| 173 | 1 | end subroutine MOM_diag_manager_end |
| 174 | ||
| 175 | !> Register a MOM diagnostic field for scalars | |
| 176 | 113 | integer function register_diag_field_infra_scalar(module_name, field_name, init_time, & |
| 177 | long_name, units, missing_value, range, standard_name, do_not_log, & | |
| 178 | err_msg, area, volume) | |
| 179 | character(len=*), intent(in) :: module_name !< The name of the associated module | |
| 180 | character(len=*), intent(in) :: field_name !< The name of the field | |
| 181 | type(time_type), optional, intent(in) :: init_time !< The registration time | |
| 182 | character(len=*), optional, intent(in) :: long_name !< A long name for the field | |
| 183 | character(len=*), optional, intent(in) :: units !< Field units | |
| 184 | character(len=*), optional, intent(in) :: standard_name !< A standard name for the field | |
| 185 | real, optional, intent(in) :: missing_value !< Missing value attribute | |
| 186 | real, dimension(2), optional, intent(in) :: range !< A valid range of the field | |
| 187 | logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged | |
| 188 | character(len=*), optional, intent(out):: err_msg !< An error message to return | |
| 189 | integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute | |
| 190 | integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute | |
| 191 | ||
| 192 | register_diag_field_infra_scalar = register_diag_field_fms(module_name, field_name, init_time, & | |
| 193 | 113 | long_name, units, missing_value, range, standard_name, do_not_log, err_msg, area, volume) |
| 194 | ||
| 195 | 226 | end function register_diag_field_infra_scalar |
| 196 | ||
| 197 | !> Register a MOM diagnostic field for scalars | |
| 198 | 3386 | integer function register_diag_field_infra_array(module_name, field_name, axes, init_time, & |
| 199 | long_name, units, missing_value, range, mask_variant, standard_name, verbose, & | |
| 200 | do_not_log, err_msg, interp_method, tile_count, area, volume) | |
| 201 | character(len=*), intent(in) :: module_name !< The name of the associated module | |
| 202 | character(len=*), intent(in) :: field_name !< The name of the field | |
| 203 | integer, dimension(:), intent(in) :: axes !< Diagnostic IDs of axis attributes for the field | |
| 204 | type(time_type), optional, intent(in) :: init_time !< The registration time | |
| 205 | character(len=*), optional, intent(in) :: long_name !< A long name for the field | |
| 206 | character(len=*), optional, intent(in) :: units !< Units of the field | |
| 207 | real, optional, intent(in) :: missing_value !< Missing value attribute | |
| 208 | real, dimension(2), optional, intent(in) :: range !< A valid range of the field | |
| 209 | logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time | |
| 210 | character(len=*), optional, intent(in) :: standard_name !< A standard name for the field | |
| 211 | logical, optional, intent(in) :: verbose !< If true, provide additional log information | |
| 212 | logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged | |
| 213 | character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should | |
| 214 | !! not be interpolated as a scalar | |
| 215 | integer, optional, intent(in) :: tile_count !< The tile number for the current PE | |
| 216 | character(len=*), optional, intent(out):: err_msg !< An error message to return | |
| 217 | integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute | |
| 218 | integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute | |
| 219 | ||
| 220 | register_diag_field_infra_array = register_diag_field_fms(module_name, field_name, axes, init_time, & | |
| 221 | long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, & | |
| 222 | 3386 | err_msg, interp_method, tile_count, area, volume) |
| 223 | ||
| 224 | 6772 | end function register_diag_field_infra_array |
| 225 | ||
| 226 | ||
| 227 | 59 | integer function register_static_field_infra(module_name, field_name, axes, long_name, units, & |
| 228 | missing_value, range, mask_variant, standard_name, do_not_log, interp_method, & | |
| 229 | tile_count, area, volume) | |
| 230 | character(len=*), intent(in) :: module_name !< The name of the associated module | |
| 231 | character(len=*), intent(in) :: field_name !< The name of the field | |
| 232 | integer, dimension(:), intent(in) :: axes !< Diagnostic IDs of axis attributes for the field | |
| 233 | character(len=*), optional, intent(in) :: long_name !< A long name for the field | |
| 234 | character(len=*), optional, intent(in) :: units !< Units of the field | |
| 235 | real, optional, intent(in) :: missing_value !< Missing value attribute | |
| 236 | real, dimension(2), optional, intent(in) :: range !< A valid range of the field | |
| 237 | logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time | |
| 238 | character(len=*), optional, intent(in) :: standard_name !< A standard name for the field | |
| 239 | logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged | |
| 240 | character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should | |
| 241 | !! not be interpolated as a scalar | |
| 242 | integer, optional, intent(in) :: tile_count !< The tile number for the current PE | |
| 243 | integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute | |
| 244 | integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute | |
| 245 | ||
| 246 | 59 | if(present(missing_value) .or. present(range)) then |
| 247 | register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& | |
| 248 | & missing_value, range, mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,& | |
| 249 | 43 | do_not_log=do_not_log, interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) |
| 250 | else | |
| 251 | register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& | |
| 252 | & mask_variant=mask_variant, standard_name=standard_name, dynamic=.false.,do_not_log=do_not_log, & | |
| 253 | 16 | interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) |
| 254 | endif | |
| 255 | 118 | end function register_static_field_infra |
| 256 | ||
| 257 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 258 | !! with the indicated unique reference id, false otherwise. | |
| 259 | 0 | logical function send_data_infra_0d(diag_field_id, field, time, err_msg) |
| 260 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 261 | real, intent(in) :: field !< The value being recorded | |
| 262 | TYPE(time_type), optional, intent(in) :: time !< The time for the current record | |
| 263 | CHARACTER(len=*), optional, intent(out) :: err_msg !< An optional error message | |
| 264 | ||
| 265 | 0 | send_data_infra_0d = send_data_fms(diag_field_id, field, time, err_msg) |
| 266 | 0 | end function send_data_infra_0d |
| 267 | ||
| 268 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 269 | !! with the indicated unique reference id, false otherwise. | |
| 270 | 0 | logical function send_data_infra_1d(diag_field_id, field, is_in, ie_in, time, mask, rmask, weight, err_msg) |
| 271 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 272 | real, dimension(:), intent(in) :: field !< A 1-d array of values being recorded | |
| 273 | integer, optional, intent(in) :: is_in !< The starting index for the data being recorded | |
| 274 | integer, optional, intent(in) :: ie_in !< The end index for the data being recorded | |
| 275 | type(time_type), optional, intent(in) :: time !< The time for the current record | |
| 276 | logical, dimension(:), optional, intent(in) :: mask !< An optional rank 1 logical mask | |
| 277 | real, dimension(:), optional, intent(in) :: rmask !< An optional rank 1 mask array | |
| 278 | real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current | |
| 279 | !! record if there is averaging in time | |
| 280 | character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon | |
| 281 | !! returning to the calling routine | |
| 282 | ||
| 283 | 0 | if(present(rmask) .or. present(weight)) then |
| 284 | 0 | if(present(rmask) .and. present(weight)) then |
| 285 | send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& | |
| 286 | 0 | weight=weight, err_msg=err_msg) |
| 287 | 0 | elseif(present(rmask)) then |
| 288 | send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, mask=mask, rmask=rmask, ie_in=ie_in,& | |
| 289 | 0 | err_msg=err_msg) |
| 290 | 0 | elseif(present(weight)) then |
| 291 | send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, weight=weight,& | |
| 292 | 0 | err_msg=err_msg) |
| 293 | endif | |
| 294 | else | |
| 295 | 0 | send_data_infra_1d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, ie_in=ie_in, err_msg=err_msg) |
| 296 | endif | |
| 297 | ||
| 298 | 0 | end function send_data_infra_1d |
| 299 | ||
| 300 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 301 | !! with the indicated unique reference id, false otherwise. | |
| 302 | 122 | logical function send_data_infra_2d(diag_field_id, field, is_in, ie_in, js_in, je_in, & |
| 303 | 244 | time, mask, rmask, weight, err_msg) |
| 304 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 305 | real, dimension(:,:), intent(in) :: field !< A 2-d array of values being recorded | |
| 306 | integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded | |
| 307 | integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded | |
| 308 | integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded | |
| 309 | integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded | |
| 310 | type(time_type), optional, intent(in) :: time !< The time for the current record | |
| 311 | logical, dimension(:,:), optional, intent(in) :: mask !< An optional 2-d logical mask | |
| 312 | real, dimension(:,:), optional, intent(in) :: rmask !< An optional 2-d mask array | |
| 313 | real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current | |
| 314 | !! record if there is averaging in time | |
| 315 | character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon | |
| 316 | !! returning to the calling routine | |
| 317 | ||
| 318 | 122 | if(present(rmask) .or. present(weight)) then |
| 319 | 97 | if(present(rmask) .and. present(weight)) then |
| 320 | send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & | |
| 321 | 96 | rmask=rmask, ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) |
| 322 | 1 | elseif(present(rmask)) then |
| 323 | send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & | |
| 324 | 1 | rmask=rmask, ie_in=ie_in, je_in=je_in, err_msg=err_msg) |
| 325 | 0 | elseif(present(weight)) then |
| 326 | send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & | |
| 327 | 0 | ie_in=ie_in, je_in=je_in, weight=weight, err_msg=err_msg) |
| 328 | endif | |
| 329 | else | |
| 330 | send_data_infra_2d = send_data_fms(diag_field_id, field, time=time, is_in=is_in, js_in=js_in, mask=mask, & | |
| 331 | 25 | ie_in=ie_in, je_in=je_in, err_msg=err_msg) |
| 332 | endif | |
| 333 | 244 | end function send_data_infra_2d |
| 334 | ||
| 335 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 336 | !! with the indicated unique reference id, false otherwise. | |
| 337 | 72 | logical function send_data_infra_3d(diag_field_id, field, is_in, ie_in, js_in, je_in, ks_in, ke_in, & |
| 338 | 72 | time, mask, rmask, weight, err_msg) |
| 339 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 340 | real, dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded | |
| 341 | integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded | |
| 342 | integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded | |
| 343 | integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded | |
| 344 | integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded | |
| 345 | integer, optional, intent(in) :: ks_in !< The starting k-index for the data being recorded | |
| 346 | integer, optional, intent(in) :: ke_in !< The end k-index for the data being recorded | |
| 347 | type(time_type), optional, intent(in) :: time !< The time for the current record | |
| 348 | logical, dimension(:,:,:), optional, intent(in) :: mask !< An optional 3-d logical mask | |
| 349 | real, dimension(:,:,:), optional, intent(in) :: rmask !< An optional 3-d mask array | |
| 350 | real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current | |
| 351 | !! record if there is averaging in time | |
| 352 | character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon | |
| 353 | !! returning to the calling routine | |
| 354 | ||
| 355 | send_data_infra_3d = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, & | |
| 356 | 72 | rmask, ie_in, je_in, ke_in, weight, err_msg) |
| 357 | ||
| 358 | 144 | end function send_data_infra_3d |
| 359 | ||
| 360 | ||
| 361 | #ifdef OVERLOAD_R8 | |
| 362 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 363 | !! with the indicated unique reference id, false otherwise. | |
| 364 | logical function send_data_infra_2d_r8(diag_field_id, field, is_in, ie_in, js_in, je_in, & | |
| 365 | time, mask, rmask, weight, err_msg) | |
| 366 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 367 | real(kind=real64), dimension(:,:), intent(in) :: field !< A 2-d array of values being recorded | |
| 368 | integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded | |
| 369 | integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded | |
| 370 | integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded | |
| 371 | integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded | |
| 372 | type(time_type), optional, intent(in) :: time !< The time for the current record | |
| 373 | logical, dimension(:,:), optional, intent(in) :: mask !< An optional 2-d logical mask | |
| 374 | real, dimension(:,:), optional, intent(in) :: rmask !< An optional 2-d mask array | |
| 375 | real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current | |
| 376 | !! record if there is averaging in time | |
| 377 | character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon | |
| 378 | !! returning to the calling routine | |
| 379 | ||
| 380 | send_data_infra_2d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & | |
| 381 | rmask, ie_in, je_in, weight, err_msg) | |
| 382 | ||
| 383 | end function send_data_infra_2d_r8 | |
| 384 | ||
| 385 | !> Returns true if the argument data are successfully passed to a diagnostic manager | |
| 386 | !! with the indicated unique reference id, false otherwise. | |
| 387 | logical function send_data_infra_3d_r8(diag_field_id, field, is_in, ie_in, js_in, je_in, ks_in, ke_in, & | |
| 388 | time, mask, rmask, weight, err_msg) | |
| 389 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 390 | real(kind=real64), dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded | |
| 391 | integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded | |
| 392 | integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded | |
| 393 | integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded | |
| 394 | integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded | |
| 395 | integer, optional, intent(in) :: ks_in !< The starting k-index for the data being recorded | |
| 396 | integer, optional, intent(in) :: ke_in !< The end k-index for the data being recorded | |
| 397 | type(time_type), optional, intent(in) :: time !< The time for the current record | |
| 398 | logical, dimension(:,:,:), optional, intent(in) :: mask !< An optional 3-d logical mask | |
| 399 | real, dimension(:,:,:), optional, intent(in) :: rmask !< An optional 3-d mask array | |
| 400 | real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current | |
| 401 | !! record if there is averaging in time | |
| 402 | character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon | |
| 403 | !! returning to the calling routine | |
| 404 | ||
| 405 | send_data_infra_3d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, rmask, & | |
| 406 | ie_in, je_in, ke_in, weight, err_msg) | |
| 407 | ||
| 408 | end function send_data_infra_3d_r8 | |
| 409 | #endif | |
| 410 | ||
| 411 | !> Add a real scalar attribute to a diagnostic field | |
| 412 | 0 | subroutine MOM_diag_field_add_attribute_scalar_r(diag_field_id, att_name, att_value) |
| 413 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 414 | character(len=*), intent(in) :: att_name !< The name of the attribute | |
| 415 | real, intent(in) :: att_value !< A real scalar value | |
| 416 | ||
| 417 | 0 | call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) |
| 418 | ||
| 419 | 0 | end subroutine MOM_diag_field_add_attribute_scalar_r |
| 420 | ||
| 421 | !> Add an integer attribute to a diagnostic field | |
| 422 | 0 | subroutine MOM_diag_field_add_attribute_scalar_i(diag_field_id, att_name, att_value) |
| 423 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 424 | character(len=*), intent(in) :: att_name !< The name of the attribute | |
| 425 | integer, intent(in) :: att_value !< An integer scalar value | |
| 426 | ||
| 427 | 0 | call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) |
| 428 | ||
| 429 | 0 | end subroutine MOM_diag_field_add_attribute_scalar_i |
| 430 | ||
| 431 | !> Add a character string attribute to a diagnostic field | |
| 432 | 10113 | subroutine MOM_diag_field_add_attribute_scalar_c(diag_field_id, att_name, att_value) |
| 433 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 434 | character(len=*), intent(in) :: att_name !< The name of the attribute | |
| 435 | character(len=*), intent(in) :: att_value !< A character string value | |
| 436 | ||
| 437 | 10113 | call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) |
| 438 | ||
| 439 | 10113 | end subroutine MOM_diag_field_add_attribute_scalar_c |
| 440 | ||
| 441 | !> Add a real list of attributes attribute to a diagnostic field | |
| 442 | 0 | subroutine MOM_diag_field_add_attribute_r1d(diag_field_id, att_name, att_value) |
| 443 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 444 | character(len=*), intent(in) :: att_name !< The name of the attribute | |
| 445 | real, dimension(:), intent(in) :: att_value !< An array of real values | |
| 446 | ||
| 447 | 0 | call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) |
| 448 | ||
| 449 | 0 | end subroutine MOM_diag_field_add_attribute_r1d |
| 450 | ||
| 451 | !> Add a integer list of attributes attribute to a diagnostic field | |
| 452 | 0 | subroutine MOM_diag_field_add_attribute_i1d(diag_field_id, att_name, att_value) |
| 453 | integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field | |
| 454 | character(len=*), intent(in) :: att_name !< The name of the attribute | |
| 455 | integer, dimension(:), intent(in) :: att_value !< An array of integer values | |
| 456 | ||
| 457 | 0 | call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) |
| 458 | ||
| 459 | 0 | end subroutine MOM_diag_field_add_attribute_i1d |
| 460 | ||
| 461 | !> Finishes the diag manager reduction methods as needed for the time_step | |
| 462 | 0 | subroutine diag_send_complete_infra () |
| 463 | !! The time_step in the diag_send_complete call is a dummy argument, needed for backwards compatibility | |
| 464 | !! It won't be used at all when diag_manager_nml::use_modern_diag=.true. | |
| 465 | !! It won't have any impact when diag_manager_nml::use_modern_diag=.false. | |
| 466 | 0 | call diag_send_complete (set_time(0)) |
| 467 | 0 | end subroutine diag_send_complete_infra |
| 468 | ||
| 469 | !> Sets the time that the simulation ends in the diag manager | |
| 470 | 1 | subroutine diag_manager_set_time_end_infra(time) |
| 471 | type(time_type), optional, intent(in) :: time !< The time the simulation ends | |
| 472 | ||
| 473 | 1 | call diag_manager_set_time_end(time) |
| 474 | 1 | end subroutine diag_manager_set_time_end_infra |
| 475 | ||
| 476 | end module MOM_diag_manager_infra |