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 | !> This module provides coupler type interfaces for use by MOM6 | |
| 6 | module MOM_coupler_types | |
| 7 | ||
| 8 | use MOM_array_transform, only : allocate_rotated_array, rotate_array | |
| 9 | use MOM_couplertype_infra, only : CT_spawn, CT_initialized, CT_destructor, atmos_ocn_coupler_flux | |
| 10 | use MOM_couplertype_infra, only : CT_set_diags, CT_send_data, CT_write_chksums, CT_data_override | |
| 11 | use MOM_couplertype_infra, only : CT_copy_data, CT_increment_data, CT_rescale_data | |
| 12 | use MOM_couplertype_infra, only : CT_set_data, CT_extract_data, CT_redistribute_data | |
| 13 | use MOM_couplertype_infra, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type | |
| 14 | use MOM_couplertype_infra, only : ind_flux, ind_alpha, ind_csurf | |
| 15 | use MOM_domain_infra, only : domain2D | |
| 16 | use MOM_time_manager, only : time_type | |
| 17 | ||
| 18 | implicit none ; private | |
| 19 | ||
| 20 | public :: coupler_type_spawn, coupler_type_destructor, coupler_type_initialized | |
| 21 | public :: coupler_type_set_diags, coupler_type_send_data, coupler_type_write_chksums | |
| 22 | public :: set_coupler_type_data, extract_coupler_type_data, coupler_type_redistribute_data | |
| 23 | public :: coupler_type_copy_data, coupler_type_increment_data, coupler_type_rescale_data | |
| 24 | public :: atmos_ocn_coupler_flux, coupler_type_data_override | |
| 25 | public :: coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type | |
| 26 | ! These are encoding constant parameters that indicate whether a flux, solubility or | |
| 27 | ! surface ocean concentration are being set or accessed with an inquiry. | |
| 28 | public :: ind_flux, ind_alpha, ind_csurf | |
| 29 | ||
| 30 | !> This is the interface to spawn one coupler_bc_type into another. | |
| 31 | interface coupler_type_spawn | |
| 32 | module procedure CT_spawn_1d_2d, CT_spawn_1d_3d, CT_spawn_2d_2d, CT_spawn_2d_3d | |
| 33 | module procedure CT_spawn_3d_2d, CT_spawn_3d_3d | |
| 34 | end interface coupler_type_spawn | |
| 35 | ||
| 36 | !> This function interface indicates whether a coupler_bc_type has been initialized. | |
| 37 | interface coupler_type_initialized | |
| 38 | module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d | |
| 39 | end interface coupler_type_initialized | |
| 40 | ||
| 41 | !> This is the interface to deallocate any data associated with a coupler_bc_type. | |
| 42 | interface coupler_type_destructor | |
| 43 | module procedure CT_destructor_1d, CT_destructor_2d | |
| 44 | end interface coupler_type_destructor | |
| 45 | ||
| 46 | !> Copy all elements of the data in either a coupler_2d_bc_type or a coupler_3d_bc_type into | |
| 47 | !! another structure of the same or the other type. Both must have the same array sizes in common | |
| 48 | !! dimensions, while the details of any expansion from 2d to 3d are controlled by arguments. | |
| 49 | interface coupler_type_copy_data | |
| 50 | module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d | |
| 51 | end interface coupler_type_copy_data | |
| 52 | ||
| 53 | !> Increment data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type with | |
| 54 | !! the data from another. Both must have the same array sizes and rank. | |
| 55 | interface coupler_type_increment_data | |
| 56 | module procedure CT_increment_data_2d, CT_increment_data_3d, CT_increment_data_2d_3d | |
| 57 | end interface coupler_type_increment_data | |
| 58 | ||
| 59 | !> Rescale the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. | |
| 60 | !! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. | |
| 61 | interface coupler_type_rescale_data | |
| 62 | module procedure CT_rescale_data_2d, CT_rescale_data_3d | |
| 63 | end interface coupler_type_rescale_data | |
| 64 | ||
| 65 | !> Redistribute the data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type into | |
| 66 | !! another, which may be on different processors with a different decomposition. | |
| 67 | interface coupler_type_redistribute_data | |
| 68 | module procedure CT_redistribute_data_2d, CT_redistribute_data_3d | |
| 69 | end interface coupler_type_redistribute_data | |
| 70 | ||
| 71 | !> Write out checksums for the elements of a coupler_2d_bc_type or coupler_3d_bc_type | |
| 72 | interface coupler_type_write_chksums | |
| 73 | module procedure CT_write_chksums_2d, CT_write_chksums_3d | |
| 74 | end interface coupler_type_write_chksums | |
| 75 | ||
| 76 | contains | |
| 77 | ||
| 78 | !> Generate a 2-D coupler type using a 1-D coupler type as a template. | |
| 79 | 0 | subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) |
| 80 | type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 81 | type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 82 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 83 | !! the first dimension in a non-decreasing list | |
| 84 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 85 | !! the second dimension in a non-decreasing list | |
| 86 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 87 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 88 | !! is not set and the parent type (var_in) is set. | |
| 89 | ||
| 90 | 0 | call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) |
| 91 | ||
| 92 | 0 | end subroutine CT_spawn_1d_2d |
| 93 | ||
| 94 | !> Generate a 3-D coupler type using a 1-D coupler type as a template. | |
| 95 | 0 | subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) |
| 96 | type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 97 | type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 98 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 99 | !! the first dimension in a non-decreasing list | |
| 100 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 101 | !! the second dimension in a non-decreasing list | |
| 102 | integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in | |
| 103 | !! a non-decreasing list | |
| 104 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 105 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 106 | !! is not set and the parent type (var_in) is set. | |
| 107 | ||
| 108 | 0 | call CT_spawn(var_in, var, idim, jdim, kdim, suffix=suffix, as_needed=as_needed) |
| 109 | ||
| 110 | 0 | end subroutine CT_spawn_1d_3d |
| 111 | ||
| 112 | !> Generate one 2-D coupler type using another 2-D coupler type as a template. | |
| 113 | 0 | subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) |
| 114 | type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 115 | type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 116 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 117 | !! the first dimension in a non-decreasing list | |
| 118 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 119 | !! the second dimension in a non-decreasing list | |
| 120 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 121 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 122 | !! is not set and the parent type (var_in) is set. | |
| 123 | ||
| 124 | 0 | call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) |
| 125 | ||
| 126 | 0 | end subroutine CT_spawn_2d_2d |
| 127 | ||
| 128 | !> Generate a 3-D coupler type using a 2-D coupler type as a template. | |
| 129 | 0 | subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) |
| 130 | type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 131 | type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 132 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 133 | !! the first dimension in a non-decreasing list | |
| 134 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 135 | !! the second dimension in a non-decreasing list | |
| 136 | integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in | |
| 137 | !! a non-decreasing list | |
| 138 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 139 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 140 | !! is not set and the parent type (var_in) is set. | |
| 141 | ||
| 142 | 0 | call CT_spawn(var_in, var, idim, jdim, kdim, suffix=suffix, as_needed=as_needed) |
| 143 | ||
| 144 | 0 | end subroutine CT_spawn_2d_3d |
| 145 | ||
| 146 | !> Generate a 2-D coupler type using a 3-D coupler type as a template. | |
| 147 | 0 | subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) |
| 148 | type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 149 | type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 150 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 151 | !! the first dimension in a non-decreasing list | |
| 152 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 153 | !! the second dimension in a non-decreasing list | |
| 154 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 155 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 156 | !! is not set and the parent type (var_in) is set. | |
| 157 | ||
| 158 | 0 | call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) |
| 159 | ||
| 160 | 0 | end subroutine CT_spawn_3d_2d |
| 161 | ||
| 162 | !> Generate a 3-D coupler type using another 3-D coupler type as a template. | |
| 163 | 0 | subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) |
| 164 | type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information | |
| 165 | type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information | |
| 166 | integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of | |
| 167 | !! the first dimension in a non-decreasing list | |
| 168 | integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of | |
| 169 | !! the second dimension in a non-decreasing list | |
| 170 | integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in | |
| 171 | !! a non-decreasing list | |
| 172 | character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique | |
| 173 | logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) | |
| 174 | !! is not set and the parent type (var_in) is set. | |
| 175 | ||
| 176 | 0 | call CT_spawn(var_in, var, idim, jdim, kdim, suffix=suffix, as_needed=as_needed) |
| 177 | ||
| 178 | 0 | end subroutine CT_spawn_3d_3d |
| 179 | ||
| 180 | !> Copy all elements of the data in a coupler_2d_bc_type into another. Both must have the same array sizes. | |
| 181 | 0 | subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & |
| 182 | exclude_flux_type, only_flux_type, pass_through_ice) | |
| 183 | type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy | |
| 184 | type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure | |
| 185 | integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default | |
| 186 | integer, optional, intent(in) :: bc_index !< The index of the boundary condition | |
| 187 | !! that is being copied | |
| 188 | integer, optional, intent(in) :: field_index !< The index of the field in the | |
| 189 | !! boundary condition that is being copied | |
| 190 | character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes | |
| 191 | !! to exclude from this copy. | |
| 192 | character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes | |
| 193 | !! to include from this copy. | |
| 194 | logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose | |
| 195 | !! value of pass_through ice matches this | |
| 196 | ||
| 197 | call CT_copy_data(var_in, var, halo_size, bc_index, field_index, & | |
| 198 | 0 | exclude_flux_type, only_flux_type, pass_through_ice) |
| 199 | 0 | end subroutine CT_copy_data_2d |
| 200 | ||
| 201 | !> Copy all elements of the data in a coupler_3d_bc_type into another. Both must have the same array sizes. | |
| 202 | 0 | subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & |
| 203 | exclude_flux_type, only_flux_type, pass_through_ice) | |
| 204 | type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy | |
| 205 | type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure | |
| 206 | integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default | |
| 207 | integer, optional, intent(in) :: bc_index !< The index of the boundary condition | |
| 208 | !! that is being copied | |
| 209 | integer, optional, intent(in) :: field_index !< The index of the field in the | |
| 210 | !! boundary condition that is being copied | |
| 211 | character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes | |
| 212 | !! to exclude from this copy. | |
| 213 | character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes | |
| 214 | !! to include from this copy. | |
| 215 | logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose | |
| 216 | !! value of pass_through ice matches this | |
| 217 | ||
| 218 | call CT_copy_data(var_in, var, halo_size, bc_index, field_index, & | |
| 219 | 0 | exclude_flux_type, only_flux_type, pass_through_ice) |
| 220 | 0 | end subroutine CT_copy_data_3d |
| 221 | ||
| 222 | !> Copy all elements of the data in a coupler_2d_bc_type into a coupler_3d_bc_type. | |
| 223 | !! Both must have the same array sizes for the first two dimensions, while the extent | |
| 224 | !! of the 3rd dimension that is being filled may be specified via optional arguments. | |
| 225 | 0 | subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & |
| 226 | exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) | |
| 227 | type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy | |
| 228 | type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure | |
| 229 | integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default | |
| 230 | integer, optional, intent(in) :: bc_index !< The index of the boundary condition | |
| 231 | !! that is being copied | |
| 232 | integer, optional, intent(in) :: field_index !< The index of the field in the | |
| 233 | !! boundary condition that is being copied | |
| 234 | character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes | |
| 235 | !! to exclude from this copy. | |
| 236 | character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes | |
| 237 | !! to include from this copy. | |
| 238 | logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose | |
| 239 | !! value of pass_through ice matches this | |
| 240 | integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd | |
| 241 | !! index of the 3d type to fill in. | |
| 242 | integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd | |
| 243 | !! index of the 3d type to fill in. | |
| 244 | ||
| 245 | call CT_copy_data(var_in, var, halo_size, bc_index, field_index, & | |
| 246 | 0 | exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) |
| 247 | 0 | end subroutine CT_copy_data_2d_3d |
| 248 | ||
| 249 | !> Increment data in all elements of one coupler_2d_bc_type with the data from another. Both | |
| 250 | !! must have the same array sizes. | |
| 251 | 0 | subroutine CT_increment_data_2d(var_in, var, halo_size, scale_factor, scale_prev) |
| 252 | type(coupler_2d_bc_type), intent(in) :: var_in !< A coupler_type structure with data in arbitrary | |
| 253 | !! arbitrary units [A] to add to the other type | |
| 254 | type(coupler_2d_bc_type), intent(inout) :: var !< A coupler_type structure with data in arbitrary | |
| 255 | !! units [B] whose fields are being incremented | |
| 256 | integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default | |
| 257 | real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added | |
| 258 | !! in arbitrary units [C A-1] | |
| 259 | real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here | |
| 260 | !! in arbitrary units [C B-1] | |
| 261 | ||
| 262 | call CT_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & | |
| 263 | 0 | scale_prev=scale_prev) |
| 264 | ||
| 265 | 0 | end subroutine CT_increment_data_2d |
| 266 | ||
| 267 | !> Increment data in all elements of one coupler_3d_bc_type with the data from another. Both | |
| 268 | !! must have the same array sizes. | |
| 269 | 0 | subroutine CT_increment_data_3d(var_in, var, halo_size, scale_factor, scale_prev, exclude_flux_type, only_flux_type) |
| 270 | type(coupler_3d_bc_type), intent(in) :: var_in !< A coupler_type structure with data in arbitrary | |
| 271 | !! arbitrary units [A] to add to the other type | |
| 272 | type(coupler_3d_bc_type), intent(inout) :: var !< A coupler_type structure with data in arbitrary | |
| 273 | !! units [B] whose fields are being incremented | |
| 274 | integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default | |
| 275 | real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added | |
| 276 | !! in arbitrary units [C A-1] | |
| 277 | real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here | |
| 278 | !! in arbitrary units [C B-1] | |
| 279 | character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types | |
| 280 | !! of fluxes to exclude from this increment. | |
| 281 | character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types | |
| 282 | !! of fluxes to include from this increment. | |
| 283 | ||
| 284 | call CT_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & | |
| 285 | scale_prev=scale_prev, exclude_flux_type=exclude_flux_type, & | |
| 286 | 0 | only_flux_type=only_flux_type) |
| 287 | ||
| 288 | 0 | end subroutine CT_increment_data_3d |
| 289 | ||
| 290 | !> Increment data in the elements of a coupler_2d_bc_type with weighted averages of elements of a | |
| 291 | !! coupler_3d_bc_type | |
| 292 | 0 | subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size) |
| 293 | type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type | |
| 294 | real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to | |
| 295 | !! increment the 2d-data [nondim]. There is no renormalization, | |
| 296 | !! so if the weights do not sum to 1 in the 3rd dimension | |
| 297 | !! there may be adverse consequences! | |
| 298 | type(coupler_2d_bc_type), intent(inout) :: var !< The coupler_type structure whose fields are being incremented | |
| 299 | integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default | |
| 300 | ||
| 301 | 0 | call CT_increment_data(var_in, weights, var, halo_size=halo_size) |
| 302 | ||
| 303 | 0 | end subroutine CT_increment_data_2d_3d |
| 304 | ||
| 305 | !> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. | |
| 306 | !! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. | |
| 307 | 0 | subroutine CT_rescale_data_2d(var, scale) |
| 308 | type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled, | |
| 309 | !! with the internal data units perhaps changing from | |
| 310 | !! arbitrary units [A] to other arbitrary units [B] | |
| 311 | real, intent(in) :: scale !< A scaling factor to multiply fields by in | |
| 312 | !! arbitrary units [B A-1] | |
| 313 | ||
| 314 | 0 | call CT_rescale_data(var, scale) |
| 315 | ||
| 316 | 0 | end subroutine CT_rescale_data_2d |
| 317 | ||
| 318 | !> Rescales the fields in the elements of a coupler_3d_bc_type by multiplying by a factor scale. | |
| 319 | !! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. | |
| 320 | 0 | subroutine CT_rescale_data_3d(var, scale) |
| 321 | type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled, | |
| 322 | !! with the internal data units perhaps changing from | |
| 323 | !! arbitrary units [A] to other arbitrary units [B] | |
| 324 | real, intent(in) :: scale !< A scaling factor to multiply fields by in | |
| 325 | !! arbitrary units [B A-1] | |
| 326 | ||
| 327 | 0 | call CT_rescale_data(var, scale) |
| 328 | ||
| 329 | 0 | end subroutine CT_rescale_data_3d |
| 330 | ||
| 331 | !> Redistribute the data in all elements of one coupler_2d_bc_type into another, which may be on | |
| 332 | !! different processors with a different decomposition. | |
| 333 | 0 | subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) |
| 334 | type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy | |
| 335 | type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure | |
| 336 | type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) | |
| 337 | type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure | |
| 338 | logical, optional, intent(in) :: complete !< If true, complete the updates | |
| 339 | ||
| 340 | 0 | call CT_redistribute_data(var_in, domain_in, var_out, domain_out, complete) |
| 341 | 0 | end subroutine CT_redistribute_data_2d |
| 342 | ||
| 343 | !> Redistribute the data in all elements of one coupler_3d_bc_type into another, which may be on | |
| 344 | !! different processors with a different decomposition. | |
| 345 | 0 | subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) |
| 346 | type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy | |
| 347 | type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure | |
| 348 | type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) | |
| 349 | type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure | |
| 350 | logical, optional, intent(in) :: complete !< If true, complete the updates | |
| 351 | ||
| 352 | 0 | call CT_redistribute_data(var_in, domain_in, var_out, domain_out, complete) |
| 353 | 0 | end subroutine CT_redistribute_data_3d |
| 354 | ||
| 355 | ||
| 356 | !> Potentially override the values in a coupler_2d_bc_type | |
| 357 | 0 | subroutine coupler_type_data_override(gridname, var, time) |
| 358 | character(len=3), intent(in) :: gridname !< 3-character long model grid ID | |
| 359 | type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override | |
| 360 | type(time_type), intent(in) :: time !< The current model time | |
| 361 | ||
| 362 | 0 | call CT_data_override(gridname, var, time) |
| 363 | 0 | end subroutine coupler_type_data_override |
| 364 | ||
| 365 | ||
| 366 | !> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array, using a | |
| 367 | !! MOM-specific interface. | |
| 368 | 0 | subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, & |
| 369 | halo_size, idim, jdim, field_index, turns) | |
| 370 | type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract | |
| 371 | !! The internal data has arbitrary units [B]. | |
| 372 | integer, intent(in) :: bc_index !< The index of the boundary condition | |
| 373 | !! that is being copied | |
| 374 | real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field in | |
| 375 | !! arbitrary units [A]; the size of this array | |
| 376 | !! must match the size of the data being copied | |
| 377 | !! unless idim and jdim are supplied. | |
| 378 | real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being | |
| 379 | !! extracted, in arbitrary units [A B-1] | |
| 380 | integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default | |
| 381 | integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of | |
| 382 | !! the first dimension of the output array | |
| 383 | !! in a non-decreasing list | |
| 384 | integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of | |
| 385 | !! the second dimension of the output array | |
| 386 | !! in a non-decreasing list | |
| 387 | integer, optional, intent(in) :: field_index !< The index of the field in the boundary | |
| 388 | !! condition that is being copied, or the | |
| 389 | !! surface flux by default. | |
| 390 | integer, optional, intent(in) :: turns !< The number of quarter-turns from the unrotated | |
| 391 | !! coupler_2d_bt_type to model grid | |
| 392 | ||
| 393 | ! Local variables | |
| 394 | 0 | real, allocatable :: array_unrot(:,:) ! Array on the unrotated grid in arbitrary units [A] |
| 395 | integer :: q_turns ! The number of quarter turns through which array_out is to be rotated | |
| 396 | integer :: index | |
| 397 | ||
| 398 | 0 | index = ind_flux ; if (present(field_index)) index = field_index |
| 399 | 0 | q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) |
| 400 | ||
| 401 | ! The case with non-trivial grid rotation is complicated by the fact that the data fields | |
| 402 | ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. | |
| 403 | 0 | if (q_turns == 0) then |
| 404 | call CT_extract_data(var_in, bc_index, index, array_out, & | |
| 405 | 0 | scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) |
| 406 | 0 | elseif (present(idim) .and. present(jdim)) then |
| 407 | 0 | call allocate_rotated_array(array_out, [1,1], -q_turns, array_unrot) |
| 408 | ||
| 409 | 0 | if (modulo(q_turns, 2) /= 0) then |
| 410 | call CT_extract_data(var_in, bc_index, index, array_unrot, & | |
| 411 | 0 | idim=jdim, jdim=idim, scale_factor=scale_factor, halo_size=halo_size) |
| 412 | else | |
| 413 | call CT_extract_data(var_in, bc_index, index, array_unrot, & | |
| 414 | 0 | idim=idim, jdim=jdim, scale_factor=scale_factor, halo_size=halo_size) |
| 415 | endif | |
| 416 | ||
| 417 | 0 | call rotate_array(array_unrot, q_turns, array_out) |
| 418 | 0 | deallocate(array_unrot) |
| 419 | else | |
| 420 | 0 | call allocate_rotated_array(array_out, [1,1], -q_turns, array_unrot) |
| 421 | call CT_extract_data(var_in, bc_index, index, array_unrot, & | |
| 422 | 0 | scale_factor=scale_factor, halo_size=halo_size) |
| 423 | 0 | call rotate_array(array_unrot, q_turns, array_out) |
| 424 | 0 | deallocate(array_unrot) |
| 425 | endif | |
| 426 | ||
| 427 | 0 | end subroutine extract_coupler_type_data |
| 428 | ||
| 429 | !> Set single 2d field in coupler_2d_bc_type from a two-dimensional array, using a | |
| 430 | !! MOM-specific interface. | |
| 431 | 0 | subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_factor, & |
| 432 | halo_size, idim, jdim, field_index, turns) | |
| 433 | real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field in | |
| 434 | !! arbitrary units [A]; the size of this array | |
| 435 | !! must match the size of the data being copied | |
| 436 | !! unless idim and jdim are supplied. | |
| 437 | integer, intent(in) :: bc_index !< The index of the boundary condition | |
| 438 | !! that is being copied | |
| 439 | type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set | |
| 440 | !! The internal data has arbitrary units [B]. | |
| 441 | logical, optional, intent(in) :: solubility !< If true and field index is missing, set | |
| 442 | !! the solubility field. Otherwise set the | |
| 443 | !! surface concentration (the default). | |
| 444 | real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being | |
| 445 | !! set, in arbitrary units [B A-1] | |
| 446 | integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default | |
| 447 | integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of | |
| 448 | !! the first dimension of the output array | |
| 449 | !! in a non-decreasing list | |
| 450 | integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of | |
| 451 | !! the second dimension of the output array | |
| 452 | !! in a non-decreasing list | |
| 453 | integer, optional, intent(in) :: field_index !< The index of the field in the | |
| 454 | !! boundary condition that is being set. The | |
| 455 | !! surface concentration is set by default. | |
| 456 | integer, optional, intent(in) :: turns !< The number of quarter-turns from the unrotated | |
| 457 | !! coupler_2d_bt_type to model grid | |
| 458 | ||
| 459 | ! Local variables | |
| 460 | 0 | real, allocatable :: array_unrot(:,:) ! Array on the unrotated grid in the same arbitrary units |
| 461 | ! as array_in [A] | |
| 462 | integer :: subfield ! An integer indicating which field to set. | |
| 463 | integer :: q_turns ! The number of quarter turns through which array_in is rotated | |
| 464 | ||
| 465 | 0 | q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) |
| 466 | ||
| 467 | 0 | subfield = ind_csurf |
| 468 | 0 | if (present(solubility)) then ; if (solubility) subfield = ind_alpha ; endif |
| 469 | 0 | if (present(field_index)) subfield = field_index |
| 470 | ||
| 471 | ! The case with non-trivial grid rotation is complicated by the fact that the data fields | |
| 472 | ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. | |
| 473 | 0 | if (q_turns == 0) then |
| 474 | call CT_set_data(array_in, bc_index, subfield, var, & | |
| 475 | 0 | scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) |
| 476 | 0 | elseif (present(idim) .and. present(jdim)) then |
| 477 | 0 | call allocate_rotated_array(array_in, [1,1], -q_turns, array_unrot) |
| 478 | 0 | call rotate_array(array_in, -q_turns, array_unrot) |
| 479 | ||
| 480 | 0 | if (modulo(q_turns, 2) /= 0) then |
| 481 | call CT_set_data(array_unrot, bc_index, subfield, var, & | |
| 482 | idim=jdim, jdim=idim, & | |
| 483 | 0 | scale_factor=scale_factor, halo_size=halo_size) |
| 484 | else | |
| 485 | call CT_set_data(array_unrot, bc_index, subfield, var, & | |
| 486 | idim=idim, jdim=jdim, & | |
| 487 | 0 | scale_factor=scale_factor, halo_size=halo_size) |
| 488 | endif | |
| 489 | ||
| 490 | 0 | deallocate(array_unrot) |
| 491 | else | |
| 492 | 0 | call allocate_rotated_array(array_in, [1,1], -q_turns, array_unrot) |
| 493 | 0 | call rotate_array(array_in, -q_turns, array_unrot) |
| 494 | call CT_set_data(array_in, bc_index, subfield, var, & | |
| 495 | 0 | scale_factor=scale_factor, halo_size=halo_size) |
| 496 | 0 | deallocate(array_unrot) |
| 497 | endif | |
| 498 | ||
| 499 | 0 | end subroutine set_coupler_type_data |
| 500 | ||
| 501 | !> Register the diagnostics of a coupler_2d_bc_type | |
| 502 | 0 | subroutine coupler_type_set_diags(var, diag_name, axes, time) |
| 503 | type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics | |
| 504 | character(len=*), intent(in) :: diag_name !< name for diagnostic file, or blank not to register the fields | |
| 505 | integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration | |
| 506 | type(time_type), intent(in) :: time !< model time variable for registering diagnostic field | |
| 507 | ||
| 508 | 0 | call CT_set_diags(var, diag_name, axes, time) |
| 509 | ||
| 510 | 0 | end subroutine coupler_type_set_diags |
| 511 | ||
| 512 | !> Write out all diagnostics of elements of a coupler_2d_bc_type | |
| 513 | 12 | subroutine coupler_type_send_data(var, Time) |
| 514 | type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write | |
| 515 | type(time_type), intent(in) :: time !< The current model time | |
| 516 | ||
| 517 | 12 | call CT_send_data(var, Time) |
| 518 | 12 | end subroutine coupler_type_send_data |
| 519 | ||
| 520 | !> Write out checksums for the elements of a coupler_2d_bc_type | |
| 521 | 0 | subroutine CT_write_chksums_2d(var, outunit, name_lead) |
| 522 | type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics | |
| 523 | integer, intent(in) :: outunit !< The index of a open output file | |
| 524 | character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names | |
| 525 | ||
| 526 | 0 | call CT_write_chksums(var, outunit, name_lead) |
| 527 | ||
| 528 | 0 | end subroutine CT_write_chksums_2d |
| 529 | ||
| 530 | !> Write out checksums for the elements of a coupler_3d_bc_type | |
| 531 | 0 | subroutine CT_write_chksums_3d(var, outunit, name_lead) |
| 532 | type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics | |
| 533 | integer, intent(in) :: outunit !< The index of a open output file | |
| 534 | character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names | |
| 535 | ||
| 536 | 0 | call CT_write_chksums(var, outunit, name_lead) |
| 537 | ||
| 538 | 0 | end subroutine CT_write_chksums_3d |
| 539 | ||
| 540 | !> Indicate whether a coupler_1d_bc_type has been initialized. | |
| 541 | 0 | logical function CT_initialized_1d(var) |
| 542 | type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed | |
| 543 | ||
| 544 | 0 | CT_initialized_1d = CT_initialized(var) |
| 545 | 0 | end function CT_initialized_1d |
| 546 | ||
| 547 | !> Indicate whether a coupler_2d_bc_type has been initialized. | |
| 548 | 0 | logical function CT_initialized_2d(var) |
| 549 | type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed | |
| 550 | ||
| 551 | 0 | CT_initialized_2d = CT_initialized(var) |
| 552 | 0 | end function CT_initialized_2d |
| 553 | ||
| 554 | !> Indicate whether a coupler_3d_bc_type has been initialized. | |
| 555 | 0 | logical function CT_initialized_3d(var) |
| 556 | type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed | |
| 557 | ||
| 558 | 0 | CT_initialized_3d = CT_initialized(var) |
| 559 | 0 | end function CT_initialized_3d |
| 560 | ||
| 561 | !> Deallocate all data associated with a coupler_1d_bc_type | |
| 562 | 0 | subroutine CT_destructor_1d(var) |
| 563 | type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed | |
| 564 | ||
| 565 | 0 | call CT_destructor(var) |
| 566 | ||
| 567 | 0 | end subroutine CT_destructor_1d |
| 568 | ||
| 569 | !> Deallocate all data associated with a coupler_2d_bc_type | |
| 570 | 0 | subroutine CT_destructor_2d(var) |
| 571 | type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed | |
| 572 | ||
| 573 | 0 | call CT_destructor(var) |
| 574 | ||
| 575 | 0 | end subroutine CT_destructor_2d |
| 576 | ||
| 577 | end module MOM_coupler_types |