Skip to content

Commit 74f2290

Browse files
Hallberg-NOAAHallberg-NOAA
committed
+Added MOM_coupler_types.F90
 Added MOM_coupler_types.F90 and MOM_couplertype_infra.F90 to provide explicit interfaces for the routines from coupler_type_mod that MOM6 uses, with some new interfaces, extract_coupler_type_data and set_coupler_type_data, that are tailored to their use in MOM6. All answers are bitwise identical, but there are some new public interfaces.
1 parent 3126f05 commit 74f2290

File tree

2 files changed

+482
-0
lines changed

2 files changed

+482
-0
lines changed

‎src/framework/MOM_coupler_types.F90

+235
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,235 @@
1+
!> This module provides coupler type interfaces for use by MOM6
2+
module MOM_coupler_types
3+
4+
! This file is part of MOM6. See LICENSE.md for the license.
5+
6+
use MOM_couplertype_infra, only : CT_spawn, CT_initialized, CT_destructor, atmos_ocn_coupler_flux
7+
use MOM_couplertype_infra, only : CT_set_diags, CT_send_data, CT_write_chksums
8+
use MOM_couplertype_infra, only : CT_copy_data, CT_increment_data, CT_set_data, CT_extract_data
9+
use MOM_couplertype_infra, only : coupler_1d_bc_type, coupler_2d_bc_type
10+
use MOM_couplertype_infra, only : ind_flux, ind_alpha, ind_csurf
11+
12+
use MOM_time_manager, only : time_type
13+
14+
implicit none ; private
15+
16+
public :: coupler_type_spawn, coupler_type_destructor, coupler_type_initialized
17+
public :: coupler_type_set_diags, coupler_type_send_data, coupler_type_write_chksums
18+
public :: set_coupler_type_data, extract_coupler_type_data
19+
public :: coupler_type_copy_data, coupler_type_increment_data
20+
public :: atmos_ocn_coupler_flux
21+
public :: ind_flux, ind_alpha, ind_csurf
22+
public :: coupler_1d_bc_type, coupler_2d_bc_type
23+
24+
!> This is the interface to spawn one coupler_bc_type into another.
25+
interface coupler_type_spawn
26+
module procedure CT_spawn_1d_2d, CT_spawn_2d_2d
27+
end interface coupler_type_spawn
28+
29+
!> This function interface indicates whether a coupler_bc_type has been initialized.
30+
interface coupler_type_initialized
31+
module procedure CT_initialized_1d, CT_initialized_2d
32+
end interface coupler_type_initialized
33+
34+
!> This is the interface to deallocate any data associated with a coupler_bc_type.
35+
interface coupler_type_destructor
36+
module procedure CT_destructor_1d, CT_destructor_2d
37+
end interface coupler_type_destructor
38+
39+
contains
40+
41+
!> Generate a 2-D coupler type using a 1-D coupler type as a template.
42+
subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed)
43+
type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information
44+
type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information
45+
integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of
46+
!! the first dimension in a non-decreasing list
47+
integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of
48+
!! the second dimension in a non-decreasing list
49+
character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique
50+
logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var)
51+
!! is not set and the parent type (var_in) is set.
52+
53+
call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed)
54+
55+
end subroutine CT_spawn_1d_2d
56+
57+
!> Generate one 2-D coupler type using another 2-D coupler type as a template.
58+
subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed)
59+
type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information
60+
type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information
61+
integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of
62+
!! the first dimension in a non-decreasing list
63+
integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of
64+
!! the second dimension in a non-decreasing list
65+
character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique
66+
logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var)
67+
!! is not set and the parent type (var_in) is set.
68+
69+
call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed)
70+
71+
end subroutine CT_spawn_2d_2d
72+
73+
!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes.
74+
subroutine coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, &
75+
exclude_flux_type, only_flux_type, pass_through_ice)
76+
type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy
77+
type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure
78+
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
79+
integer, optional, intent(in) :: bc_index !< The index of the boundary condition
80+
!! that is being copied
81+
integer, optional, intent(in) :: field_index !< The index of the field in the
82+
!! boundary condition that is being copied
83+
character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes
84+
!! to exclude from this copy.
85+
character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes
86+
!! to include from this copy.
87+
logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose
88+
!! value of pass_through ice matches this
89+
90+
call CT_copy_data(var_in, var, halo_size, bc_index, field_index, &
91+
exclude_flux_type, only_flux_type, pass_through_ice)
92+
end subroutine coupler_type_copy_data
93+
94+
!> Increment data in all elements of one coupler_2d_bc_type with the data from another. Both
95+
!! must have the same array sizes.
96+
subroutine coupler_type_increment_data(var_in, var, halo_size, scale_factor, scale_prev)
97+
type(coupler_2d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type
98+
type(coupler_2d_bc_type), intent(inout) :: var !< The coupler_type structure whose fields are being incremented
99+
integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default
100+
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
101+
real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here
102+
103+
call CT_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, &
104+
scale_prev=scale_prev)
105+
106+
end subroutine coupler_type_increment_data
107+
108+
!> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array, using a
109+
!! MOM-specific interface.
110+
subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, &
111+
halo_size, idim, jdim, field_index)
112+
type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract
113+
integer, intent(in) :: bc_index !< The index of the boundary condition
114+
!! that is being copied
115+
real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size
116+
!! must match the size of the data being copied
117+
!! unless idim and jdim are supplied.
118+
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
119+
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
120+
integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of
121+
!! the first dimension of the output array
122+
!! in a non-decreasing list
123+
integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of
124+
!! the second dimension of the output array
125+
!! in a non-decreasing list
126+
integer, optional, intent(in) :: field_index !< The index of the field in the boundary
127+
!! condition that is being copied, or the
128+
!! surface flux by default.
129+
130+
if (present(field_index)) then
131+
call CT_extract_data(var_in, bc_index, field_index, array_out, &
132+
scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim)
133+
else
134+
call CT_extract_data(var_in, bc_index, ind_flux, array_out, &
135+
scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim)
136+
endif
137+
138+
end subroutine extract_coupler_type_data
139+
140+
!> Set single 2d field in coupler_2d_bc_type from a two-dimensional array, using a
141+
!! MOM-specific interface.
142+
subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_factor, &
143+
halo_size, idim, jdim, field_index)
144+
real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size
145+
!! must match the size of the data being copied
146+
!! unless idim and jdim are supplied.
147+
integer, intent(in) :: bc_index !< The index of the boundary condition
148+
!! that is being copied
149+
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set
150+
logical, optional, intent(in) :: solubility !< If true and field index is missing, set
151+
!! the solubility field. Otherwise set the
152+
!! surface concentration (the default).
153+
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
154+
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
155+
integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of
156+
!! the first dimension of the output array
157+
!! in a non-decreasing list
158+
integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of
159+
!! the second dimension of the output array
160+
!! in a non-decreasing list
161+
integer, optional, intent(in) :: field_index !< The index of the field in the
162+
!! boundary condition that is being set. The
163+
!! surface concentration is set by default.
164+
165+
integer :: subfield ! An integer indicating which field to set.
166+
167+
subfield = ind_csurf
168+
if (present(solubility)) then ; if (solubility) subfield = ind_alpha ; endif
169+
if (present(field_index)) subfield = field_index
170+
171+
call CT_set_data(array_in, bc_index, subfield, var, &
172+
scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim)
173+
174+
end subroutine set_coupler_type_data
175+
176+
!> Register the diagnostics of a coupler_2d_bc_type
177+
subroutine coupler_type_set_diags(var, diag_name, axes, time)
178+
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics
179+
character(len=*), intent(in) :: diag_name !< name for diagnostic file, or blank not to register the fields
180+
integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration
181+
type(time_type), intent(in) :: time !< model time variable for registering diagnostic field
182+
183+
call CT_set_diags(var, diag_name, axes, time)
184+
185+
end subroutine coupler_type_set_diags
186+
187+
!> Write out all diagnostics of elements of a coupler_2d_bc_type
188+
subroutine coupler_type_send_data(var, Time)
189+
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write
190+
type(time_type), intent(in) :: time !< The current model time
191+
192+
call CT_send_data(var, Time)
193+
end subroutine coupler_type_send_data
194+
195+
!> Write out checksums for the elements of a coupler_2d_bc_type
196+
subroutine coupler_type_write_chksums(var, outunit, name_lead)
197+
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics
198+
integer, intent(in) :: outunit !< The index of a open output file
199+
character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names
200+
201+
call CT_write_chksums(var, outunit, name_lead)
202+
203+
end subroutine coupler_type_write_chksums
204+
205+
!> Indicate whether a coupler_1d_bc_type has been initialized.
206+
logical function CT_initialized_1d(var)
207+
type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed
208+
209+
CT_initialized_1d = CT_initialized(var)
210+
end function CT_initialized_1d
211+
212+
!> Indicate whether a coupler_2d_bc_type has been initialized.
213+
logical function CT_initialized_2d(var)
214+
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed
215+
216+
CT_initialized_2d = CT_initialized(var)
217+
end function CT_initialized_2d
218+
219+
!> Deallocate all data associated with a coupler_1d_bc_type
220+
subroutine CT_destructor_1d(var)
221+
type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed
222+
223+
call CT_destructor(var)
224+
225+
end subroutine CT_destructor_1d
226+
227+
!> Deallocate all data associated with a coupler_2d_bc_type
228+
subroutine CT_destructor_2d(var)
229+
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed
230+
231+
call CT_destructor(var)
232+
233+
end subroutine CT_destructor_2d
234+
235+
end module MOM_coupler_types

0 commit comments

Comments
 (0)