MOM6
MOM_ALE_sponge.F90
1 !> This module contains the routines used to apply sponge layers when using
2 !! the ALE mode.
3 !!
4 !! Applying sponges requires the following:
5 !! 1. initialize_ALE_sponge
6 !! 2. set_up_ALE_sponge_field (tracers) and set_up_ALE_sponge_vel_field (vel)
7 !! 3. apply_ALE_sponge
8 !! 4. init_ALE_sponge_diags (not being used for now)
9 !! 5. ALE_sponge_end (not being used for now)
10 
12 
13 ! This file is part of MOM6. See LICENSE.md for the license.
14 
15 use mom_coms, only : sum_across_pes
16 use mom_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field
17 use mom_diag_mediator, only : diag_ctrl
18 use mom_error_handler, only : mom_error, fatal, note, warning, is_root_pe
20 use mom_grid, only : ocean_grid_type
22 use mom_spatial_means, only : global_i_mean
23 use mom_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init
24 use mom_remapping, only : remapping_cs, remapping_core_h, initialize_remapping
27 ! GMM - Planned extension: Support for time varying sponge targets.
28 
29 implicit none ; private
30 
31 #include <MOM_memory.h>
32 
33 !> Store the reference profile at h points for a variable
35  module procedure set_up_ale_sponge_field_fixed
36  module procedure set_up_ale_sponge_field_varying
37 end interface
38 
39 !> This subroutine stores the reference profile at u and v points for a vector
41  module procedure set_up_ale_sponge_vel_field_fixed
42  module procedure set_up_ale_sponge_vel_field_varying
43 end interface
44 
45 !> Ddetermine the number of points which are within sponges in this computational domain.
46 !!
47 !! Only points that have positive values of Iresttime and which mask2dT indicates are ocean
48 !! points are included in the sponges. It also stores the target interface heights.
50  module procedure initialize_ale_sponge_fixed
51  module procedure initialize_ale_sponge_varying
52 end interface
53 
54 ! Publicly available functions
56 public get_ale_sponge_thicknesses, get_ale_sponge_nz_data
57 public initialize_ale_sponge, apply_ale_sponge, ale_sponge_end, init_ale_sponge_diags
58 
59 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
60 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
61 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
62 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
63 
64 !> A structure for creating arrays of pointers to 3D arrays with extra gridding information
65 type :: p3d
66  integer :: id !< id for FMS external time interpolator
67  integer :: nz_data !< The number of vertical levels in the input field.
68  integer :: num_tlevs !< The number of time records contained in the file
69  real, dimension(:,:,:), pointer :: mask_in => null() !< pointer to the data mask.
70  real, dimension(:,:,:), pointer :: p => null() !< pointer to the data.
71  real, dimension(:,:,:), pointer :: h => null() !< pointer to the data grid.
72 end type p3d
73 
74 !> A structure for creating arrays of pointers to 2D arrays with extra gridding information
75 type :: p2d
76  integer :: id !< id for FMS external time interpolator
77  integer :: nz_data !< The number of vertical levels in the input field
78  integer :: num_tlevs !< The number of time records contained in the file
79  real, dimension(:,:), pointer :: mask_in => null()!< pointer to the data mask.
80  real, dimension(:,:), pointer :: p => null() !< pointer the data.
81  real, dimension(:,:), pointer :: h => null() !< pointer the data grid.
82 end type p2d
83 
84 !> ALE sponge control structure
85 type, public :: ale_sponge_cs ; private
86  integer :: nz !< The total number of layers.
87  integer :: nz_data !< The total number of arbritary layers (used by older code).
88  integer :: isc !< The starting i-index of the computational domain at h.
89  integer :: iec !< The ending i-index of the computational domain at h.
90  integer :: jsc !< The starting j-index of the computational domain at h.
91  integer :: jec !< The ending j-index of the computational domain at h.
92  integer :: iscb !< The starting I-index of the computational domain at u/v.
93  integer :: iecb !< The ending I-index of the computational domain at u/v.
94  integer :: jscb !< The starting J-index of the computational domain at u/v.
95  integer :: jecb !< The ending J-index of the computational domain at h.
96  integer :: isd !< The starting i-index of the data domain at h.
97  integer :: ied !< The ending i-index of the data domain at h.
98  integer :: jsd !< The starting j-index of the data domain at h.
99  integer :: jed !< The ending j-index of the data domain at h.
100  integer :: num_col !< The number of sponge tracer points within the computational domain.
101  integer :: num_col_u !< The number of sponge u-points within the computational domain.
102  integer :: num_col_v !< The number of sponge v-points within the computational domain.
103  integer :: fldno = 0 !< The number of fields which have already been
104  !! registered by calls to set_up_sponge_field
105  logical :: sponge_uv !< Control whether u and v are included in sponge
106  integer, pointer :: col_i(:) => null() !< Array of the i-indicies of each tracer columns being damped.
107  integer, pointer :: col_j(:) => null() !< Array of the j-indicies of each tracer columns being damped.
108  integer, pointer :: col_i_u(:) => null() !< Array of the i-indicies of each u-columns being damped.
109  integer, pointer :: col_j_u(:) => null() !< Array of the j-indicies of each u-columns being damped.
110  integer, pointer :: col_i_v(:) => null() !< Array of the i-indicies of each v-columns being damped.
111  integer, pointer :: col_j_v(:) => null() !< Array of the j-indicies of each v-columns being damped.
112 
113  real, pointer :: iresttime_col(:) => null() !< The inverse restoring time of each tracer column [s-1].
114  real, pointer :: iresttime_col_u(:) => null() !< The inverse restoring time of each u-column [s-1].
115  real, pointer :: iresttime_col_v(:) => null() !< The inverse restoring time of each v-column [s-1].
116 
117  type(p3d) :: var(max_fields_) !< Pointers to the fields that are being damped.
118  type(p2d) :: ref_val(max_fields_) !< The values to which the fields are damped.
119  type(p2d) :: ref_val_u !< The values to which the u-velocities are damped.
120  type(p2d) :: ref_val_v !< The values to which the v-velocities are damped.
121  type(p3d) :: var_u !< Pointer to the u velocities. that are being damped.
122  type(p3d) :: var_v !< Pointer to the v velocities. that are being damped.
123  type(p2d) :: ref_h !< Grid on which reference data is provided (older code).
124  type(p2d) :: ref_hu !< u-point grid on which reference data is provided (older code).
125  type(p2d) :: ref_hv !< v-point grid on which reference data is provided (older code).
126 
127  type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
128  !! timing of diagnostic output.
129 
130  type(remapping_cs) :: remap_cs !< Remapping parameters and work arrays
131 
132  logical :: new_sponges !< True if using newer sponge code
133 end type ale_sponge_cs
134 
135 contains
136 
137 !> This subroutine determines the number of points which are within sponges in this computational
138 !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean
139 !! points are included in the sponges. It also stores the target interface heights.
140 subroutine initialize_ale_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data)
141 
142  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
143  integer, intent(in) :: nz_data !< The total number of sponge input layers.
144  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [s-1].
145  type(param_file_type), intent(in) :: param_file !< A structure indicating the open file
146  !! to parse for model parameter values.
147  type(ale_sponge_cs), pointer :: CS !< A pointer that is set to point to the control
148  !! structure for this module (in/out).
149  real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge
150  !! input layers [H ~> m or kg m-2].
151 
152 
153 ! This include declares and sets the variable "version".
154 #include "version_variable.h"
155  character(len=40) :: mdl = "MOM_sponge" ! This module's name.
156  logical :: use_sponge
157  real, allocatable, dimension(:,:,:) :: data_hu !< thickness at u points [H ~> m or kg m-2]
158  real, allocatable, dimension(:,:,:) :: data_hv !< thickness at v points [H ~> m or kg m-2]
159  real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points [s-1]
160  real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points [s-1]
161  logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries
162  integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v
163  character(len=10) :: remapScheme
164  if (associated(cs)) then
165  call mom_error(warning, "initialize_sponge called with an associated "// &
166  "control structure.")
167  return
168  endif
169 
170 ! Set default, read and log parameters
171  call log_version(param_file, mdl, version, "")
172  call get_param(param_file, mdl, "SPONGE", use_sponge, &
173  "If true, sponges may be applied anywhere in the domain. "//&
174  "The exact location and properties of those sponges are "//&
175  "specified from MOM_initialization.F90.", default=.false.)
176 
177  if (.not.use_sponge) return
178 
179  allocate(cs)
180 
181  call get_param(param_file, mdl, "SPONGE_UV", cs%sponge_uv, &
182  "Apply sponges in u and v, in addition to tracers.", &
183  default=.false.)
184 
185  call get_param(param_file, mdl, "REMAPPING_SCHEME", remapscheme, &
186  "This sets the reconstruction scheme used "//&
187  " for vertical remapping for all variables.", &
188  default="PLM", do_not_log=.true.)
189 
190  call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", bndextrapolation, &
191  "When defined, a proper high-order reconstruction "//&
192  "scheme is used within boundary cells rather "//&
193  "than PCM. E.g., if PPM is used for remapping, a "//&
194  "PPM reconstruction will also be used within boundary cells.", &
195  default=.false., do_not_log=.true.)
196 
197  cs%new_sponges = .false.
198  cs%nz = g%ke
199  cs%isc = g%isc ; cs%iec = g%iec ; cs%jsc = g%jsc ; cs%jec = g%jec
200  cs%isd = g%isd ; cs%ied = g%ied ; cs%jsd = g%jsd ; cs%jed = g%jed
201  cs%iscB = g%iscB ; cs%iecB = g%iecB; cs%jscB = g%jscB ; cs%jecB = g%jecB
202 
203  ! number of columns to be restored
204  cs%num_col = 0 ; cs%fldno = 0
205  do j=g%jsc,g%jec ; do i=g%isc,g%iec
206  if ((iresttime(i,j)>0.0) .and. (g%mask2dT(i,j)>0)) &
207  cs%num_col = cs%num_col + 1
208  enddo ; enddo
209 
210  if (cs%num_col > 0) then
211  allocate(cs%Iresttime_col(cs%num_col)) ; cs%Iresttime_col = 0.0
212  allocate(cs%col_i(cs%num_col)) ; cs%col_i = 0
213  allocate(cs%col_j(cs%num_col)) ; cs%col_j = 0
214  ! pass indices, restoring time to the CS structure
215  col = 1
216  do j=g%jsc,g%jec ; do i=g%isc,g%iec
217  if ((iresttime(i,j)>0.0) .and. (g%mask2dT(i,j)>0)) then
218  cs%col_i(col) = i ; cs%col_j(col) = j
219  cs%Iresttime_col(col) = iresttime(i,j)
220  col = col +1
221  endif
222  enddo ; enddo
223  ! same for total number of arbritary layers and correspondent data
224  cs%nz_data = nz_data
225  allocate(cs%Ref_h%p(cs%nz_data,cs%num_col))
226  do col=1,cs%num_col ; do k=1,cs%nz_data
227  cs%Ref_h%p(k,col) = data_h(cs%col_i(col),cs%col_j(col),k)
228  enddo ; enddo
229  endif
230 
231  total_sponge_cols = cs%num_col
232  call sum_across_pes(total_sponge_cols)
233 
234 ! Call the constructor for remapping control structure
235  call initialize_remapping(cs%remap_cs, remapscheme, boundary_extrapolation=bndextrapolation)
236 
237  call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, &
238  "The total number of columns where sponges are applied at h points.")
239 
240  if (cs%sponge_uv) then
241 
242  allocate(data_hu(g%isdB:g%iedB,g%jsd:g%jed,nz_data)); data_hu(:,:,:)=0.0
243  allocate(data_hv(g%isd:g%ied,g%jsdB:g%jedB,nz_data)); data_hv(:,:,:)=0.0
244  allocate(iresttime_u(g%isdB:g%iedB,g%jsd:g%jed)); iresttime_u(:,:)=0.0
245  allocate(iresttime_v(g%isd:g%ied,g%jsdB:g%jedB)); iresttime_v(:,:)=0.0
246 
247  ! u points
248  cs%num_col_u = 0 ; !CS%fldno_u = 0
249  do j=cs%jsc,cs%jec; do i=cs%iscB,cs%iecB
250  data_hu(i,j,:) = 0.5 * (data_h(i,j,:) + data_h(i+1,j,:))
251  iresttime_u(i,j) = 0.5 * (iresttime(i,j) + iresttime(i+1,j))
252  if ((iresttime_u(i,j)>0.0) .and. (g%mask2dCu(i,j)>0)) &
253  cs%num_col_u = cs%num_col_u + 1
254  enddo ; enddo
255 
256  if (cs%num_col_u > 0) then
257 
258  allocate(cs%Iresttime_col_u(cs%num_col_u)) ; cs%Iresttime_col_u = 0.0
259  allocate(cs%col_i_u(cs%num_col_u)) ; cs%col_i_u = 0
260  allocate(cs%col_j_u(cs%num_col_u)) ; cs%col_j_u = 0
261 
262  ! pass indices, restoring time to the CS structure
263  col = 1
264  do j=cs%jsc,cs%jec ; do i=cs%iscB,cs%iecB
265  if ((iresttime_u(i,j)>0.0) .and. (g%mask2dCu(i,j)>0)) then
266  cs%col_i_u(col) = i ; cs%col_j_u(col) = j
267  cs%Iresttime_col_u(col) = iresttime_u(i,j)
268  col = col +1
269  endif
270  enddo ; enddo
271 
272  ! same for total number of arbritary layers and correspondent data
273 
274  allocate(cs%Ref_hu%p(cs%nz_data,cs%num_col_u))
275  do col=1,cs%num_col_u ; do k=1,cs%nz_data
276  cs%Ref_hu%p(k,col) = data_hu(cs%col_i_u(col),cs%col_j_u(col),k)
277  enddo ; enddo
278  endif
279  total_sponge_cols_u = cs%num_col_u
280  call sum_across_pes(total_sponge_cols_u)
281  call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, &
282  "The total number of columns where sponges are applied at u points.")
283 
284  ! v points
285  cs%num_col_v = 0 ; !CS%fldno_v = 0
286  do j=cs%jscB,cs%jecB; do i=cs%isc,cs%iec
287  data_hv(i,j,:) = 0.5 * (data_h(i,j,:) + data_h(i,j+1,:))
288  iresttime_v(i,j) = 0.5 * (iresttime(i,j) + iresttime(i,j+1))
289  if ((iresttime_v(i,j)>0.0) .and. (g%mask2dCv(i,j)>0)) &
290  cs%num_col_v = cs%num_col_v + 1
291  enddo ; enddo
292 
293  if (cs%num_col_v > 0) then
294 
295  allocate(cs%Iresttime_col_v(cs%num_col_v)) ; cs%Iresttime_col_v = 0.0
296  allocate(cs%col_i_v(cs%num_col_v)) ; cs%col_i_v = 0
297  allocate(cs%col_j_v(cs%num_col_v)) ; cs%col_j_v = 0
298 
299  ! pass indices, restoring time to the CS structure
300  col = 1
301  do j=cs%jscB,cs%jecB ; do i=cs%isc,cs%iec
302  if ((iresttime_v(i,j)>0.0) .and. (g%mask2dCv(i,j)>0)) then
303  cs%col_i_v(col) = i ; cs%col_j_v(col) = j
304  cs%Iresttime_col_v(col) = iresttime_v(i,j)
305  col = col +1
306  endif
307  enddo ; enddo
308 
309  ! same for total number of arbritary layers and correspondent data
310  allocate(cs%Ref_hv%p(cs%nz_data,cs%num_col_v))
311  do col=1,cs%num_col_v ; do k=1,cs%nz_data
312  cs%Ref_hv%p(k,col) = data_hv(cs%col_i_v(col),cs%col_j_v(col),k)
313  enddo ; enddo
314  endif
315  total_sponge_cols_v = cs%num_col_v
316  call sum_across_pes(total_sponge_cols_v)
317  call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, &
318  "The total number of columns where sponges are applied at v points.")
319  endif
320 
321 end subroutine initialize_ale_sponge_fixed
322 
323 !> Return the number of layers in the data with a fixed ALE sponge, or 0 if there are
324 !! no sponge columns on this PE.
325 function get_ale_sponge_nz_data(CS)
326  type(ale_sponge_cs), pointer :: cs !< A pointer that is set to point to the control
327  !! structure for the ALE_sponge module.
328  integer :: get_ale_sponge_nz_data !< The number of layers in the fixed sponge data.
329 
330  if (associated(cs)) then
331  get_ale_sponge_nz_data = cs%nz_data
332  else
333  get_ale_sponge_nz_data = 0
334  endif
335 end function get_ale_sponge_nz_data
336 
337 !> Return the thicknesses used for the data with a fixed ALE sponge
338 subroutine get_ale_sponge_thicknesses(G, data_h, sponge_mask, CS)
339  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure (in).
340  real, allocatable, dimension(:,:,:), &
341  intent(inout) :: data_h !< The thicknesses of the sponge input layers [H ~> m or kg m-2].
342  logical, dimension(SZI_(G),SZJ_(G)), &
343  intent(out) :: sponge_mask !< A logical mask that is true where
344  !! sponges are being applied.
345  type(ale_sponge_cs), pointer :: cs !< A pointer that is set to point to the control
346  !! structure for the ALE_sponge module.
347  integer :: c, i, j, k
348 
349  if (allocated(data_h)) call mom_error(fatal, &
350  "get_ALE_sponge_thicknesses called with an allocated data_h.")
351 
352  if (.not.associated(cs)) then
353  ! There are no sponge points on this PE.
354  allocate(data_h(g%isd:g%ied,g%jsd:g%jed,1)) ; data_h(:,:,:) = -1.0
355  sponge_mask(:,:) = .false.
356  return
357  endif
358 
359  allocate(data_h(g%isd:g%ied,g%jsd:g%jed,cs%nz_data)) ; data_h(:,:,:) = -1.0
360  sponge_mask(:,:) = .false.
361 
362  do c=1,cs%num_col
363  i = cs%col_i(c) ; j = cs%col_j(c)
364  sponge_mask(i,j) = .true.
365  do k=1,cs%nz_data
366  data_h(i,j,k) = cs%Ref_h%p(k,c)
367  enddo
368  enddo
369 
370 end subroutine get_ale_sponge_thicknesses
371 
372 !> This subroutine determines the number of points which are within sponges in this computational
373 !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean
374 !! points are included in the sponges.
375 subroutine initialize_ale_sponge_varying(Iresttime, G, param_file, CS)
376 
377  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
378  real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [s-1].
379  type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse
380  !! for model parameter values.
381  type(ale_sponge_cs), pointer :: CS !< A pointer that is set to point to the control
382  !! structure for this module (in/out).
383 
384 
385 
386 ! This include declares and sets the variable "version".
387 #include "version_variable.h"
388  character(len=40) :: mdl = "MOM_sponge" ! This module's name.
389  logical :: use_sponge
390  real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points [s-1]
391  real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points [s-1]
392  logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries
393  integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v
394  character(len=10) :: remapScheme
395  if (associated(cs)) then
396  call mom_error(warning, "initialize_sponge called with an associated "// &
397  "control structure.")
398  return
399  endif
400 
401 ! Set default, read and log parameters
402  call log_version(param_file, mdl, version, "")
403  call get_param(param_file, mdl, "SPONGE", use_sponge, &
404  "If true, sponges may be applied anywhere in the domain. "//&
405  "The exact location and properties of those sponges are "//&
406  "specified from MOM_initialization.F90.", default=.false.)
407 
408  if (.not.use_sponge) return
409 
410  allocate(cs)
411 
412  call get_param(param_file, mdl, "SPONGE_UV", cs%sponge_uv, &
413  "Apply sponges in u and v, in addition to tracers.", &
414  default=.false.)
415 
416  call get_param(param_file, mdl, "REMAPPING_SCHEME", remapscheme, &
417  "This sets the reconstruction scheme used "//&
418  " for vertical remapping for all variables.", &
419  default="PLM", do_not_log=.true.)
420 
421  call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", bndextrapolation, &
422  "When defined, a proper high-order reconstruction "//&
423  "scheme is used within boundary cells rather "//&
424  "than PCM. E.g., if PPM is used for remapping, a "//&
425  "PPM reconstruction will also be used within boundary cells.", &
426  default=.false., do_not_log=.true.)
427 
428  cs%new_sponges = .true.
429  cs%nz = g%ke
430  cs%isc = g%isc ; cs%iec = g%iec ; cs%jsc = g%jsc ; cs%jec = g%jec
431  cs%isd = g%isd ; cs%ied = g%ied ; cs%jsd = g%jsd ; cs%jed = g%jed
432  cs%iscB = g%iscB ; cs%iecB = g%iecB; cs%jscB = g%jscB ; cs%jecB = g%jecB
433 
434  ! number of columns to be restored
435  cs%num_col = 0 ; cs%fldno = 0
436  do j=g%jsc,g%jec ; do i=g%isc,g%iec
437  if ((iresttime(i,j)>0.0) .and. (g%mask2dT(i,j)>0)) &
438  cs%num_col = cs%num_col + 1
439  enddo ; enddo
440 
441 
442  if (cs%num_col > 0) then
443  allocate(cs%Iresttime_col(cs%num_col)) ; cs%Iresttime_col = 0.0
444  allocate(cs%col_i(cs%num_col)) ; cs%col_i = 0
445  allocate(cs%col_j(cs%num_col)) ; cs%col_j = 0
446  ! pass indices, restoring time to the CS structure
447  col = 1
448  do j=g%jsc,g%jec ; do i=g%isc,g%iec
449  if ((iresttime(i,j)>0.0) .and. (g%mask2dT(i,j)>0)) then
450  cs%col_i(col) = i ; cs%col_j(col) = j
451  cs%Iresttime_col(col) = iresttime(i,j)
452  col = col +1
453  endif
454  enddo ; enddo
455  endif
456 
457  total_sponge_cols = cs%num_col
458  call sum_across_pes(total_sponge_cols)
459 
460 ! Call the constructor for remapping control structure
461  call initialize_remapping(cs%remap_cs, remapscheme, boundary_extrapolation=bndextrapolation)
462 
463  call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, &
464  "The total number of columns where sponges are applied at h points.")
465 
466  if (cs%sponge_uv) then
467 
468  allocate(iresttime_u(g%isdB:g%iedB,g%jsd:g%jed)); iresttime_u(:,:)=0.0
469  allocate(iresttime_v(g%isd:g%ied,g%jsdB:g%jedB)); iresttime_v(:,:)=0.0
470 
471  ! u points
472  cs%num_col_u = 0 ; !CS%fldno_u = 0
473  do j=cs%jsc,cs%jec; do i=cs%iscB,cs%iecB
474  iresttime_u(i,j) = 0.5 * (iresttime(i,j) + iresttime(i+1,j))
475  if ((iresttime_u(i,j)>0.0) .and. (g%mask2dCu(i,j)>0)) &
476  cs%num_col_u = cs%num_col_u + 1
477  enddo ; enddo
478 
479  if (cs%num_col_u > 0) then
480 
481  allocate(cs%Iresttime_col_u(cs%num_col_u)) ; cs%Iresttime_col_u = 0.0
482  allocate(cs%col_i_u(cs%num_col_u)) ; cs%col_i_u = 0
483  allocate(cs%col_j_u(cs%num_col_u)) ; cs%col_j_u = 0
484 
485  ! pass indices, restoring time to the CS structure
486  col = 1
487  do j=cs%jsc,cs%jec ; do i=cs%iscB,cs%iecB
488  if ((iresttime_u(i,j)>0.0) .and. (g%mask2dCu(i,j)>0)) then
489  cs%col_i_u(col) = i ; cs%col_j_u(col) = j
490  cs%Iresttime_col_u(col) = iresttime_u(i,j)
491  col = col +1
492  endif
493  enddo ; enddo
494 
495  ! same for total number of arbritary layers and correspondent data
496 
497  endif
498  total_sponge_cols_u = cs%num_col_u
499  call sum_across_pes(total_sponge_cols_u)
500  call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, &
501  "The total number of columns where sponges are applied at u points.")
502 
503  ! v points
504  cs%num_col_v = 0 ; !CS%fldno_v = 0
505  do j=cs%jscB,cs%jecB; do i=cs%isc,cs%iec
506  iresttime_v(i,j) = 0.5 * (iresttime(i,j) + iresttime(i,j+1))
507  if ((iresttime_v(i,j)>0.0) .and. (g%mask2dCv(i,j)>0)) &
508  cs%num_col_v = cs%num_col_v + 1
509  enddo ; enddo
510 
511  if (cs%num_col_v > 0) then
512 
513  allocate(cs%Iresttime_col_v(cs%num_col_v)) ; cs%Iresttime_col_v = 0.0
514  allocate(cs%col_i_v(cs%num_col_v)) ; cs%col_i_v = 0
515  allocate(cs%col_j_v(cs%num_col_v)) ; cs%col_j_v = 0
516 
517  ! pass indices, restoring time to the CS structure
518  col = 1
519  do j=cs%jscB,cs%jecB ; do i=cs%isc,cs%iec
520  if ((iresttime_v(i,j)>0.0) .and. (g%mask2dCv(i,j)>0)) then
521  cs%col_i_v(col) = i ; cs%col_j_v(col) = j
522  cs%Iresttime_col_v(col) = iresttime_v(i,j)
523  col = col +1
524  endif
525  enddo ; enddo
526 
527  endif
528  total_sponge_cols_v = cs%num_col_v
529  call sum_across_pes(total_sponge_cols_v)
530  call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, &
531  "The total number of columns where sponges are applied at v points.")
532  endif
533 
534 end subroutine initialize_ale_sponge_varying
535 
536 !> Initialize diagnostics for the ALE_sponge module.
537 ! GMM: this routine is not being used for now.
538 subroutine init_ale_sponge_diags(Time, G, diag, CS)
539  type(time_type), target, intent(in) :: time !< The current model time
540  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
541  type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic
542  !! output.
543  type(ale_sponge_cs), pointer :: cs !< ALE sponge control structure
544 
545  if (.not.associated(cs)) return
546 
547  cs%diag => diag
548 
549 end subroutine init_ale_sponge_diags
550 
551 !> This subroutine stores the reference profile at h points for the variable
552 !! whose address is given by f_ptr.
553 subroutine set_up_ale_sponge_field_fixed(sp_val, G, f_ptr, CS)
554  type(ocean_grid_type), intent(in) :: G !< Grid structure
555  type(ale_sponge_cs), pointer :: CS !< ALE sponge control structure (in/out).
556  real, dimension(SZI_(G),SZJ_(G),CS%nz_data), &
557  intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers.
558  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
559  target, intent(in) :: f_ptr !< Pointer to the field to be damped
560 
561  integer :: j, k, col
562  character(len=256) :: mesg ! String for error messages
563 
564  if (.not.associated(cs)) return
565 
566  cs%fldno = cs%fldno + 1
567 
568  if (cs%fldno > max_fields_) then
569  write(mesg,'("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease &
570  &the number of fields to be damped in the call to &
571  &initialize_sponge." )') cs%fldno
572  call mom_error(fatal,"set_up_ALE_sponge_field: "//mesg)
573  endif
574 
575  ! stores the reference profile
576  allocate(cs%Ref_val(cs%fldno)%p(cs%nz_data,cs%num_col))
577  cs%Ref_val(cs%fldno)%p(:,:) = 0.0
578  do col=1,cs%num_col
579  do k=1,cs%nz_data
580  cs%Ref_val(cs%fldno)%p(k,col) = sp_val(cs%col_i(col),cs%col_j(col),k)
581  enddo
582  enddo
583 
584  cs%var(cs%fldno)%p => f_ptr
585 
586 end subroutine set_up_ale_sponge_field_fixed
587 
588 !> This subroutine stores the reference profile at h points for the variable
589 !! whose address is given by filename and fieldname.
590 subroutine set_up_ale_sponge_field_varying(filename, fieldname, Time, G, GV, f_ptr, CS)
591  character(len=*), intent(in) :: filename !< The name of the file with the
592  !! time varying field data
593  character(len=*), intent(in) :: fieldname !< The name of the field in the file
594  !! with the time varying field data
595  type(time_type), intent(in) :: Time !< The current model time
596  type(ocean_grid_type), intent(in) :: G !< Grid structure (in).
597  type(verticalgrid_type), intent(in) :: GV !< ocean vertical grid structure
598  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
599  target, intent(in) :: f_ptr !< Pointer to the field to be damped (in).
600  type(ale_sponge_cs), pointer :: CS !< Sponge control structure (in/out).
601 
602  ! Local variables
603  real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge
604  real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data
605  real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights [Z ~> m].
606  real :: missing_value
607  integer :: j, k, col
608  integer :: isd,ied,jsd,jed
609  integer :: nPoints
610  integer, dimension(4) :: fld_sz
611  integer :: nz_data !< the number of vertical levels in this input field
612  character(len=256) :: mesg ! String for error messages
613 
614  ! Local variables for ALE remapping
615  real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m].
616  real, dimension(:), allocatable :: tmpT1d
617  real :: zTopOfCell, zBottomOfCell ! Heights [Z ~> m].
618  type(remapping_cs) :: remapCS ! Remapping parameters and work arrays
619 
620  if (.not.associated(cs)) return
621 
622  ! Call this in case it was not previously done.
623  call time_interp_external_init()
624 
625  isd = g%isd; ied = g%ied; jsd = g%jsd; jed = g%jed
626  cs%fldno = cs%fldno + 1
627 
628  if (cs%fldno > max_fields_) then
629  write(mesg,'("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease &
630  &the number of fields to be damped in the call to &
631  &initialize_sponge." )') cs%fldno
632  call mom_error(fatal,"set_up_ALE_sponge_field: "//mesg)
633  endif
634 
635  ! get a unique id for this field which will allow us to return an array
636  ! containing time-interpolated values from an external file corresponding
637  ! to the current model date.
638 
639  cs%Ref_val(cs%fldno)%id = init_external_field(filename, fieldname)
640  fld_sz(1:4)=-1
641  fld_sz = get_external_field_size(cs%Ref_val(cs%fldno)%id)
642  nz_data = fld_sz(3)
643  cs%Ref_val(cs%fldno)%nz_data = nz_data !< each individual sponge field is assumed to reside on a different grid
644  cs%Ref_val(cs%fldno)%num_tlevs = fld_sz(4)
645 
646  allocate( sp_val(isd:ied,jsd:jed, nz_data) )
647  allocate( mask_z(isd:ied,jsd:jed, nz_data) )
648 
649  ! initializes the current reference profile array
650  allocate(cs%Ref_val(cs%fldno)%p(nz_data,cs%num_col))
651  cs%Ref_val(cs%fldno)%p(:,:) = 0.0
652  allocate( cs%Ref_val(cs%fldno)%h(nz_data,cs%num_col) )
653  cs%Ref_val(cs%fldno)%h(:,:) = 0.0
654 
655  ! Interpolate external file data to the model grid
656  ! I am hard-wiring this call to assume that the input grid is zonally re-entrant
657  ! In the future, this should be generalized using an interface to return the
658  ! modulo attribute of the zonal axis (mjh).
659 
660  ! call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, &
661  ! missing_value, .true., .false., .false., m_to_Z=US%m_to_Z)
662 
663 ! Do not think halo updates are needed (mjh)
664 ! call pass_var(sp_val,G%Domain)
665 ! call pass_var(mask_z,G%Domain)
666 
667 ! Done with horizontal interpolation.
668 ! Now remap to model coordinates
669 ! First we reserve a work space for reconstructions of the source data
670  allocate( hsrc(nz_data) )
671  allocate( tmpt1d(nz_data) )
672 
673  do col=1,cs%num_col
674  ! Build the source grid
675  ztopofcell = 0. ; zbottomofcell = 0. ; npoints = 0; hsrc(:) = 0.0; tmpt1d(:) = -99.9
676  do k=1,nz_data
677  if (mask_z(cs%col_i(col),cs%col_j(col),k) == 1.0) then
678  zbottomofcell = -min( z_edges_in(k+1), g%bathyT(cs%col_i(col),cs%col_j(col)) )
679 ! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k)
680  elseif (k>1) then
681  zbottomofcell = -g%bathyT(cs%col_i(col),cs%col_j(col))
682 ! tmpT1d(k) = tmpT1d(k-1)
683 ! else ! This next block should only ever be reached over land
684 ! tmpT1d(k) = -99.9
685  endif
686  hsrc(k) = ztopofcell - zbottomofcell
687  if (hsrc(k)>0.) npoints = npoints + 1
688  ztopofcell = zbottomofcell ! Bottom becomes top for next value of k
689  enddo
690  ! In case data is deeper than model
691  hsrc(nz_data) = hsrc(nz_data) + ( ztopofcell + g%bathyT(cs%col_i(col),cs%col_j(col)) )
692  cs%Ref_val(cs%fldno)%h(1:nz_data,col) = 0.
693  cs%Ref_val(cs%fldno)%p(1:nz_data,col) = -1.e24
694  cs%Ref_val(cs%fldno)%h(1:nz_data,col) = gv%Z_to_H*hsrc(1:nz_data)
695 ! CS%Ref_val(CS%fldno)%p(1:nz_data,col) = tmpT1d(1:nz_data)
696  enddo
697 
698  cs%var(cs%fldno)%p => f_ptr
699 
700  deallocate( hsrc )
701  deallocate( tmpt1d )
702  deallocate(sp_val, mask_z)
703 
704 end subroutine set_up_ale_sponge_field_varying
705 
706 !> This subroutine stores the reference profile at u and v points for the variable
707 !! whose address is given by u_ptr and v_ptr.
708 subroutine set_up_ale_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS)
709  type(ocean_grid_type), intent(in) :: G !< Grid structure (in).
710  type(ale_sponge_cs), pointer :: CS !< Sponge structure (in/out).
711  real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), &
712  intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers.
713  real, dimension(SZI_(G),SZJB_(G),CS%nz_data), &
714  intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers.
715  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped
716  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped
717 
718  integer :: j, k, col
719  character(len=256) :: mesg ! String for error messages
720 
721  if (.not.associated(cs)) return
722 
723  ! stores the reference profile
724  allocate(cs%Ref_val_u%p(cs%nz_data,cs%num_col_u))
725  cs%Ref_val_u%p(:,:) = 0.0
726  do col=1,cs%num_col_u
727  do k=1,cs%nz_data
728  cs%Ref_val_u%p(k,col) = u_val(cs%col_i_u(col),cs%col_j_u(col),k)
729  enddo
730  enddo
731 
732  cs%var_u%p => u_ptr
733 
734  allocate(cs%Ref_val_v%p(cs%nz_data,cs%num_col_v))
735  cs%Ref_val_v%p(:,:) = 0.0
736  do col=1,cs%num_col_v
737  do k=1,cs%nz_data
738  cs%Ref_val_v%p(k,col) = v_val(cs%col_i_v(col),cs%col_j_v(col),k)
739  enddo
740  enddo
741 
742  cs%var_v%p => v_ptr
743 
744 end subroutine set_up_ale_sponge_vel_field_fixed
745 
746 !> This subroutine stores the reference profile at uand v points for the variable
747 !! whose address is given by u_ptr and v_ptr.
748 subroutine set_up_ale_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, &
749  Time, G, US, CS, u_ptr, v_ptr)
750  character(len=*), intent(in) :: filename_u !< File name for u field
751  character(len=*), intent(in) :: fieldname_u !< Name of u variable in file
752  character(len=*), intent(in) :: filename_v !< File name for v field
753  character(len=*), intent(in) :: fieldname_v !< Name of v variable in file
754  type(time_type), intent(in) :: Time !< Model time
755  type(ocean_grid_type), intent(inout) :: G !< Ocean grid (in)
756  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
757  type(ale_sponge_cs), pointer :: CS !< Sponge structure (in/out).
758  real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in).
759  real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in).
760  ! Local variables
761  real, allocatable, dimension(:,:,:) :: u_val !< U field to be used in the sponge.
762  real, allocatable, dimension(:,:,:) :: mask_u !< U field mask for the sponge data.
763  real, allocatable, dimension(:,:,:) :: v_val !< V field to be used in the sponge.
764  real, allocatable, dimension(:,:,:) :: mask_v !< V field mask for the sponge data.
765 
766  real, allocatable, dimension(:), target :: z_in, z_edges_in
767  real :: missing_value
768 
769  integer :: j, k, col
770  integer :: isd, ied, jsd, jed
771  integer :: isdB, iedB, jsdB, jedB
772  integer, dimension(4) :: fld_sz
773  character(len=256) :: mesg ! String for error messages
774 
775  if (.not.associated(cs)) return
776 
777  isd = g%isd; ied = g%ied; jsd = g%jsd; jed = g%jed
778  isdb = g%isdB; iedb = g%iedB; jsdb = g%jsdB; jedb = g%jedB
779 
780  ! get a unique id for this field which will allow us to return an array
781  ! containing time-interpolated values from an external file corresponding
782  ! to the current model date.
783 
784  cs%Ref_val_u%id = init_external_field(filename_u, fieldname_u)
785  fld_sz(1:4)=-1
786  fld_sz = get_external_field_size(cs%Ref_val_u%id)
787  cs%Ref_val_u%nz_data = fld_sz(3)
788  cs%Ref_val_u%num_tlevs = fld_sz(4)
789 
790  cs%Ref_val_v%id = init_external_field(filename_v, fieldname_v)
791  fld_sz(1:4)=-1
792  fld_sz = get_external_field_size(cs%Ref_val_v%id)
793  cs%Ref_val_v%nz_data = fld_sz(3)
794  cs%Ref_val_v%num_tlevs = fld_sz(4)
795 
796  allocate( u_val(isdb:iedb,jsd:jed, fld_sz(3)) )
797  allocate( mask_u(isdb:iedb,jsd:jed, fld_sz(3)) )
798  allocate( v_val(isd:ied,jsdb:jedb, fld_sz(3)) )
799  allocate( mask_v(isd:ied,jsdb:jedb, fld_sz(3)) )
800 
801  ! Interpolate external file data to the model grid
802  ! I am hard-wiring this call to assume that the input grid is zonally re-entrant
803  ! In the future, this should be generalized using an interface to return the
804  ! modulo attribute of the zonal axis (mjh).
805 
806  call horiz_interp_and_extrap_tracer(cs%Ref_val_u%id,time, 1.0,g,u_val,mask_u,z_in,z_edges_in,&
807  missing_value,.true.,.false.,.false., m_to_z=us%m_to_Z)
808 
809 !!! TODO: add a velocity interface! (mjh)
810 
811  ! Interpolate external file data to the model grid
812  ! I am hard-wiring this call to assume that the input grid is zonally re-entrant
813  ! In the future, this should be generalized using an interface to return the
814  ! modulo attribute of the zonal axis (mjh).
815 
816  call horiz_interp_and_extrap_tracer(cs%Ref_val_v%id,time, 1.0,g,v_val,mask_v,z_in,z_edges_in, &
817  missing_value,.true.,.false.,.false., m_to_z=us%m_to_Z)
818 
819  ! stores the reference profile
820  allocate(cs%Ref_val_u%p(fld_sz(3),cs%num_col_u))
821  cs%Ref_val_u%p(:,:) = 0.0
822  do col=1,cs%num_col_u
823  do k=1,fld_sz(3)
824  cs%Ref_val_u%p(k,col) = u_val(cs%col_i_u(col),cs%col_j_u(col),k)
825  enddo
826  enddo
827 
828  cs%var_u%p => u_ptr
829 
830  allocate(cs%Ref_val_v%p(fld_sz(3),cs%num_col_v))
831  cs%Ref_val_v%p(:,:) = 0.0
832  do col=1,cs%num_col_v
833  do k=1,fld_sz(3)
834  cs%Ref_val_v%p(k,col) = v_val(cs%col_i_v(col),cs%col_j_v(col),k)
835  enddo
836  enddo
837 
838  cs%var_v%p => v_ptr
839 
840 end subroutine set_up_ale_sponge_vel_field_varying
841 
842 !> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers
843 !! for every column where there is damping.
844 subroutine apply_ale_sponge(h, dt, G, GV, US, CS, Time)
845  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure (in).
846  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
847  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
848  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
849  intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in)
850  real, intent(in) :: dt !< The amount of time covered by this call [s].
851  type(ale_sponge_cs), pointer :: cs !< A pointer to the control structure for this module
852  !! that is set by a previous call to initialize_sponge (in).
853  type(time_type), optional, intent(in) :: time !< The current model date
854 
855  real :: damp ! The timestep times the local damping coefficient [nondim].
856  real :: i1pdamp ! I1pdamp is 1/(1 + damp). [nondim].
857  real :: idt ! 1.0/dt [s-1].
858  real :: m_to_z ! A unit conversion factor from m to Z.
859  real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid
860  real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid
861  real :: hu(szib_(g), szj_(g), szk_(g)) ! A temporary array for h at u pts
862  real :: hv(szi_(g), szjb_(g), szk_(g)) ! A temporary array for h at v pts
863  real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields
864  real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts
865  integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz, nz_data
866  real, allocatable, dimension(:), target :: z_in, z_edges_in
867  real :: missing_value
868  real :: h_neglect, h_neglect_edge
869 
870  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
871 
872  if (.not.associated(cs)) return
873 
874  if (gv%Boussinesq) then
875  h_neglect = gv%m_to_H*1.0e-30 ; h_neglect_edge = gv%m_to_H*1.0e-10
876  else
877  h_neglect = gv%kg_m2_to_H*1.0e-30 ; h_neglect_edge = gv%kg_m2_to_H*1.0e-10
878  endif
879 
880  if (cs%new_sponges) then
881  if (.not. present(time)) &
882  call mom_error(fatal,"apply_ALE_sponge: No time information provided")
883 
884 ! Interpolate new grid in time-space
885  do m=1,cs%fldno
886 
887  nz_data = cs%Ref_val(m)%nz_data
888  allocate(sp_val(g%isd:g%ied,g%jsd:g%jed,1:nz_data))
889  allocate(mask_z(g%isd:g%ied,g%jsd:g%jed,1:nz_data))
890  sp_val(:,:,:)=0.0
891  mask_z(:,:,:)=0.0
892 
893  call horiz_interp_and_extrap_tracer(cs%Ref_val(cs%fldno)%id,time, 1.0,g,sp_val,mask_z,z_in,z_edges_in, &
894  missing_value,.true., .false.,.false., m_to_z=us%m_to_Z)
895 
896 ! call pass_var(sp_val,G%Domain)
897 ! call pass_var(mask_z,G%Domain)
898 
899 
900  do c=1,cs%num_col
901  i = cs%col_i(c) ; j = cs%col_j(c)
902  cs%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data)
903  do k=2,nz_data
904 ! if (mask_z(i,j,k)==0.) &
905  if (cs%Ref_val(m)%h(k,c) <= 0.001*gv%m_to_H) &
906  ! some confusion here about why the masks are not correct returning from horiz_interp
907  ! reverting to using a minimum thickness criteria
908  cs%Ref_val(m)%p(k,c) = cs%Ref_val(m)%p(k-1,c)
909  enddo
910  enddo
911 
912  deallocate(sp_val, mask_z)
913  enddo
914  else
915  nz_data = cs%nz_data
916  endif
917 
918  allocate(tmp_val2(nz_data))
919 
920  do m=1,cs%fldno
921  do c=1,cs%num_col
922 ! c is an index for the next 3 lines but a multiplier for the rest of the loop
923 ! Therefore we use c as per C code and increment the index where necessary.
924  i = cs%col_i(c) ; j = cs%col_j(c)
925  damp = dt*cs%Iresttime_col(c)
926  i1pdamp = 1.0 / (1.0 + damp)
927  tmp_val2(1:nz_data) = cs%Ref_val(m)%p(1:nz_data,c)
928  if (cs%new_sponges) then
929  call remapping_core_h(cs%remap_cs, nz_data, cs%Ref_val(m)%h(1:nz_data,c), tmp_val2, &
930  cs%nz, h(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
931  else
932  call remapping_core_h(cs%remap_cs,nz_data, cs%Ref_h%p(1:nz_data,c), tmp_val2, &
933  cs%nz, h(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
934  endif
935  !Backward Euler method
936  cs%var(m)%p(i,j,1:cs%nz) = i1pdamp * (cs%var(m)%p(i,j,1:cs%nz) + tmp_val1 * damp)
937 
938  enddo
939  enddo
940 
941  ! for debugging
942  !c=CS%num_col
943  !do m=1,CS%fldno
944  ! write(*,*) 'APPLY SPONGE,m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1',&
945  ! m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1
946  !enddo
947 
948  if (cs%sponge_uv) then
949 
950  ! u points
951  do j=cs%jsc,cs%jec; do i=cs%iscB,cs%iecB; do k=1,nz
952  hu(i,j,k) = 0.5 * (h(i,j,k) + h(i+1,j,k))
953  enddo ; enddo ; enddo
954 
955  if (cs%new_sponges) then
956  if (.not. present(time)) &
957  call mom_error(fatal,"apply_ALE_sponge: No time information provided")
958 
959  nz_data = cs%Ref_val_u%nz_data
960  allocate(sp_val(g%isdB:g%iedB,g%jsd:g%jed,1:nz_data))
961  allocate(mask_z(g%isdB:g%iedB,g%jsd:g%jed,1:nz_data))
962 ! Interpolate from the external horizontal grid and in time
963  call horiz_interp_and_extrap_tracer(cs%Ref_val_u%id,time, 1.0,g,sp_val,mask_z,z_in,z_edges_in, &
964  missing_value, .true., .false., .false., m_to_z=us%m_to_Z)
965 
966 ! call pass_var(sp_val,G%Domain)
967 ! call pass_var(mask_z,G%Domain)
968 
969  do c=1,cs%num_col
970 ! c is an index for the next 3 lines but a multiplier for the rest of the loop
971 ! Therefore we use c as per C code and increment the index where necessary.
972  i = cs%col_i(c) ; j = cs%col_j(c)
973  cs%Ref_val_u%p(1:nz_data,c) = sp_val(i,j,1:nz_data)
974  enddo
975 
976  deallocate (sp_val, mask_z)
977 
978  nz_data = cs%Ref_val_v%nz_data
979  allocate(sp_val(g%isd:g%ied,g%jsdB:g%jedB,1:nz_data))
980  allocate(mask_z(g%isd:g%ied,g%jsdB:g%jedB,1:nz_data))
981 ! Interpolate from the external horizontal grid and in time
982  call horiz_interp_and_extrap_tracer(cs%Ref_val_v%id,time, 1.0,g,sp_val,mask_z,z_in,z_edges_in, &
983  missing_value, .true., .false., .false., m_to_z=us%m_to_Z)
984 
985 ! call pass_var(sp_val,G%Domain)
986 ! call pass_var(mask_z,G%Domain)
987 
988  do c=1,cs%num_col
989 ! c is an index for the next 3 lines but a multiplier for the rest of the loop
990 ! Therefore we use c as per C code and increment the index where necessary.
991  i = cs%col_i(c) ; j = cs%col_j(c)
992  cs%Ref_val_v%p(1:nz_data,c) = sp_val(i,j,1:nz_data)
993  enddo
994 
995  deallocate (sp_val, mask_z)
996 
997  else
998  nz_data = cs%nz_data
999  endif
1000 
1001  do c=1,cs%num_col_u
1002  i = cs%col_i_u(c) ; j = cs%col_j_u(c)
1003  damp = dt*cs%Iresttime_col_u(c)
1004  i1pdamp = 1.0 / (1.0 + damp)
1005  if (cs%new_sponges) nz_data = cs%Ref_val(m)%nz_data
1006  tmp_val2(1:nz_data) = cs%Ref_val_u%p(1:nz_data,c)
1007  if (cs%new_sponges) then
1008  call remapping_core_h(cs%remap_cs, nz_data, cs%Ref_val_u%h(:,c), tmp_val2, &
1009  cs%nz, hu(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
1010  else
1011  call remapping_core_h(cs%remap_cs, nz_data, cs%Ref_hu%p(:,c), tmp_val2, &
1012  cs%nz, hu(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
1013  endif
1014  !Backward Euler method
1015  cs%var_u%p(i,j,:) = i1pdamp * (cs%var_u%p(i,j,:) + tmp_val1 * damp)
1016  enddo
1017 
1018  ! v points
1019  do j=cs%jscB,cs%jecB; do i=cs%isc,cs%iec; do k=1,nz
1020  hv(i,j,k) = 0.5 * (h(i,j,k) + h(i,j+1,k))
1021  enddo ; enddo ; enddo
1022 
1023  do c=1,cs%num_col_v
1024  i = cs%col_i_v(c) ; j = cs%col_j_v(c)
1025  damp = dt*cs%Iresttime_col_v(c)
1026  i1pdamp = 1.0 / (1.0 + damp)
1027  tmp_val2(1:nz_data) = cs%Ref_val_v%p(1:nz_data,c)
1028  if (cs%new_sponges) then
1029  call remapping_core_h(cs%remap_cs, cs%nz_data, cs%Ref_val_v%h(:,c), tmp_val2, &
1030  cs%nz, hv(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
1031  else
1032  call remapping_core_h(cs%remap_cs, cs%nz_data, cs%Ref_hv%p(:,c), tmp_val2, &
1033  cs%nz, hv(i,j,:), tmp_val1, h_neglect, h_neglect_edge)
1034  endif
1035  !Backward Euler method
1036  cs%var_v%p(i,j,:) = i1pdamp * (cs%var_v%p(i,j,:) + tmp_val1 * damp)
1037  enddo
1038 
1039  endif
1040 
1041  deallocate(tmp_val2)
1042 
1043 end subroutine apply_ale_sponge
1044 
1045 ! GMM: I could not find where sponge_end is being called, but I am keeping
1046 ! ALE_sponge_end here so we can add that if needed.
1047 !> This subroutine deallocates any memory associated with the ALE_sponge module.
1048 subroutine ale_sponge_end(CS)
1049  type(ale_sponge_cs), pointer :: cs !< A pointer to the control structure that is
1050  !! set by a previous call to initialize_sponge.
1051 
1052  integer :: m
1053 
1054  if (.not.associated(cs)) return
1055 
1056  if (associated(cs%col_i)) deallocate(cs%col_i)
1057  if (associated(cs%col_i_u)) deallocate(cs%col_i_u)
1058  if (associated(cs%col_i_v)) deallocate(cs%col_i_v)
1059  if (associated(cs%col_j)) deallocate(cs%col_j)
1060  if (associated(cs%col_j_u)) deallocate(cs%col_j_u)
1061  if (associated(cs%col_j_v)) deallocate(cs%col_j_v)
1062 
1063  if (associated(cs%Iresttime_col)) deallocate(cs%Iresttime_col)
1064  if (associated(cs%Iresttime_col_u)) deallocate(cs%Iresttime_col_u)
1065  if (associated(cs%Iresttime_col_v)) deallocate(cs%Iresttime_col_v)
1066 
1067  do m=1,cs%fldno
1068  if (associated(cs%Ref_val(cs%fldno)%p)) deallocate(cs%Ref_val(cs%fldno)%p)
1069  enddo
1070 
1071  deallocate(cs)
1072 
1073 end subroutine ale_sponge_end
1074 end module mom_ale_sponge
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_spatial_means
Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means.
Definition: MOM_spatial_means.F90:2
mom_horizontal_regridding::horiz_interp_and_extrap_tracer
Extrapolate and interpolate data.
Definition: MOM_horizontal_regridding.F90:52
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_ale_sponge::initialize_ale_sponge
Ddetermine the number of points which are within sponges in this computational domain.
Definition: MOM_ALE_sponge.F90:49
mom_ale_sponge::ale_sponge_cs
ALE sponge control structure.
Definition: MOM_ALE_sponge.F90:85
mom_remapping::remapping_cs
Container for remapping parameters.
Definition: MOM_remapping.F90:22
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_ale_sponge
This module contains the routines used to apply sponge layers when using the ALE mode.
Definition: MOM_ALE_sponge.F90:11
mom_horizontal_regridding
Horizontal interpolation.
Definition: MOM_horizontal_regridding.F90:2
mom_ale_sponge::p2d
A structure for creating arrays of pointers to 2D arrays with extra gridding information.
Definition: MOM_ALE_sponge.F90:75
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_coms
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Definition: MOM_coms.F90:3
mom_remapping
Provides column-wise vertical remapping functions.
Definition: MOM_remapping.F90:2
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_ale_sponge::set_up_ale_sponge_field
Store the reference profile at h points for a variable.
Definition: MOM_ALE_sponge.F90:34
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_ale_sponge::p3d
A structure for creating arrays of pointers to 3D arrays with extra gridding information.
Definition: MOM_ALE_sponge.F90:65
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:25
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239
mom_ale_sponge::set_up_ale_sponge_vel_field
This subroutine stores the reference profile at u and v points for a vector.
Definition: MOM_ALE_sponge.F90:40