23 use mom_time_manager,
only : time_type, init_external_field, get_external_field_size, time_interp_external_init
29 implicit none ;
private
31 #include <MOM_memory.h>
35 module procedure set_up_ale_sponge_field_fixed
36 module procedure set_up_ale_sponge_field_varying
41 module procedure set_up_ale_sponge_vel_field_fixed
42 module procedure set_up_ale_sponge_vel_field_varying
50 module procedure initialize_ale_sponge_fixed
51 module procedure initialize_ale_sponge_varying
56 public get_ale_sponge_thicknesses, get_ale_sponge_nz_data
69 real,
dimension(:,:,:),
pointer :: mask_in => null()
70 real,
dimension(:,:,:),
pointer :: p => null()
71 real,
dimension(:,:,:),
pointer :: h => null()
79 real,
dimension(:,:),
pointer :: mask_in => null()
80 real,
dimension(:,:),
pointer :: p => null()
81 real,
dimension(:,:),
pointer :: h => null()
106 integer,
pointer :: col_i(:) => null()
107 integer,
pointer :: col_j(:) => null()
108 integer,
pointer :: col_i_u(:) => null()
109 integer,
pointer :: col_j_u(:) => null()
110 integer,
pointer :: col_i_v(:) => null()
111 integer,
pointer :: col_j_v(:) => null()
113 real,
pointer :: iresttime_col(:) => null()
114 real,
pointer :: iresttime_col_u(:) => null()
115 real,
pointer :: iresttime_col_v(:) => null()
117 type(
p3d) :: var(max_fields_)
118 type(
p2d) :: ref_val(max_fields_)
132 logical :: new_sponges
140 subroutine initialize_ale_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data)
143 integer,
intent(in) :: nz_data
144 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: Iresttime
149 real,
dimension(SZI_(G),SZJ_(G),nz_data),
intent(in) :: data_h
154 #include "version_variable.h"
155 character(len=40) :: mdl =
"MOM_sponge"
156 logical :: use_sponge
157 real,
allocatable,
dimension(:,:,:) :: data_hu
158 real,
allocatable,
dimension(:,:,:) :: data_hv
159 real,
allocatable,
dimension(:,:) :: Iresttime_u
160 real,
allocatable,
dimension(:,:) :: Iresttime_v
161 logical :: bndExtrapolation = .true.
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.")
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.)
177 if (.not.use_sponge)
return
181 call get_param(param_file, mdl,
"SPONGE_UV", cs%sponge_uv, &
182 "Apply sponges in u and v, in addition to tracers.", &
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.)
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.)
197 cs%new_sponges = .false.
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
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
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
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)
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)
231 total_sponge_cols = cs%num_col
232 call sum_across_pes(total_sponge_cols)
235 call initialize_remapping(cs%remap_cs, remapscheme, boundary_extrapolation=bndextrapolation)
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.")
240 if (cs%sponge_uv)
then
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
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
256 if (cs%num_col_u > 0)
then
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
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)
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)
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.")
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
293 if (cs%num_col_v > 0)
then
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
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)
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)
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.")
321 end subroutine initialize_ale_sponge_fixed
325 function get_ale_sponge_nz_data(CS)
328 integer :: get_ale_sponge_nz_data
330 if (
associated(cs))
then
331 get_ale_sponge_nz_data = cs%nz_data
333 get_ale_sponge_nz_data = 0
335 end function get_ale_sponge_nz_data
338 subroutine get_ale_sponge_thicknesses(G, data_h, sponge_mask, CS)
340 real,
allocatable,
dimension(:,:,:), &
341 intent(inout) :: data_h
342 logical,
dimension(SZI_(G),SZJ_(G)), &
343 intent(out) :: sponge_mask
347 integer :: c, i, j, k
349 if (
allocated(data_h))
call mom_error(fatal, &
350 "get_ALE_sponge_thicknesses called with an allocated data_h.")
352 if (.not.
associated(cs))
then
354 allocate(data_h(g%isd:g%ied,g%jsd:g%jed,1)) ; data_h(:,:,:) = -1.0
355 sponge_mask(:,:) = .false.
359 allocate(data_h(g%isd:g%ied,g%jsd:g%jed,cs%nz_data)) ; data_h(:,:,:) = -1.0
360 sponge_mask(:,:) = .false.
363 i = cs%col_i(c) ; j = cs%col_j(c)
364 sponge_mask(i,j) = .true.
366 data_h(i,j,k) = cs%Ref_h%p(k,c)
370 end subroutine get_ale_sponge_thicknesses
375 subroutine initialize_ale_sponge_varying(Iresttime, G, param_file, CS)
378 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: Iresttime
387 #include "version_variable.h"
388 character(len=40) :: mdl =
"MOM_sponge"
389 logical :: use_sponge
390 real,
allocatable,
dimension(:,:) :: Iresttime_u
391 real,
allocatable,
dimension(:,:) :: Iresttime_v
392 logical :: bndExtrapolation = .true.
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.")
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.)
408 if (.not.use_sponge)
return
412 call get_param(param_file, mdl,
"SPONGE_UV", cs%sponge_uv, &
413 "Apply sponges in u and v, in addition to tracers.", &
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.)
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.)
428 cs%new_sponges = .true.
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
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
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
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)
457 total_sponge_cols = cs%num_col
458 call sum_across_pes(total_sponge_cols)
461 call initialize_remapping(cs%remap_cs, remapscheme, boundary_extrapolation=bndextrapolation)
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.")
466 if (cs%sponge_uv)
then
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
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
479 if (cs%num_col_u > 0)
then
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
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)
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.")
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
511 if (cs%num_col_v > 0)
then
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
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)
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.")
534 end subroutine initialize_ale_sponge_varying
538 subroutine init_ale_sponge_diags(Time, G, diag, CS)
539 type(time_type),
target,
intent(in) :: time
541 type(
diag_ctrl),
target,
intent(inout) :: diag
545 if (.not.
associated(cs))
return
549 end subroutine init_ale_sponge_diags
553 subroutine set_up_ale_sponge_field_fixed(sp_val, G, f_ptr, CS)
556 real,
dimension(SZI_(G),SZJ_(G),CS%nz_data), &
558 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
559 target,
intent(in) :: f_ptr
562 character(len=256) :: mesg
564 if (.not.
associated(cs))
return
566 cs%fldno = cs%fldno + 1
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)
576 allocate(cs%Ref_val(cs%fldno)%p(cs%nz_data,cs%num_col))
577 cs%Ref_val(cs%fldno)%p(:,:) = 0.0
580 cs%Ref_val(cs%fldno)%p(k,col) = sp_val(cs%col_i(col),cs%col_j(col),k)
584 cs%var(cs%fldno)%p => f_ptr
586 end subroutine set_up_ale_sponge_field_fixed
590 subroutine set_up_ale_sponge_field_varying(filename, fieldname, Time, G, GV, f_ptr, CS)
591 character(len=*),
intent(in) :: filename
593 character(len=*),
intent(in) :: fieldname
595 type(time_type),
intent(in) :: Time
598 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
599 target,
intent(in) :: f_ptr
603 real,
allocatable,
dimension(:,:,:) :: sp_val
604 real,
allocatable,
dimension(:,:,:) :: mask_z
605 real,
allocatable,
dimension(:),
target :: z_in, z_edges_in
606 real :: missing_value
608 integer :: isd,ied,jsd,jed
610 integer,
dimension(4) :: fld_sz
612 character(len=256) :: mesg
615 real,
dimension(:),
allocatable :: hsrc
616 real,
dimension(:),
allocatable :: tmpT1d
617 real :: zTopOfCell, zBottomOfCell
620 if (.not.
associated(cs))
return
623 call time_interp_external_init()
625 isd = g%isd; ied = g%ied; jsd = g%jsd; jed = g%jed
626 cs%fldno = cs%fldno + 1
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)
639 cs%Ref_val(cs%fldno)%id = init_external_field(filename, fieldname)
641 fld_sz = get_external_field_size(cs%Ref_val(cs%fldno)%id)
643 cs%Ref_val(cs%fldno)%nz_data = nz_data
644 cs%Ref_val(cs%fldno)%num_tlevs = fld_sz(4)
646 allocate( sp_val(isd:ied,jsd:jed, nz_data) )
647 allocate( mask_z(isd:ied,jsd:jed, nz_data) )
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
670 allocate( hsrc(nz_data) )
671 allocate( tmpt1d(nz_data) )
675 ztopofcell = 0. ; zbottomofcell = 0. ; npoints = 0; hsrc(:) = 0.0; tmpt1d(:) = -99.9
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)) )
681 zbottomofcell = -g%bathyT(cs%col_i(col),cs%col_j(col))
686 hsrc(k) = ztopofcell - zbottomofcell
687 if (hsrc(k)>0.) npoints = npoints + 1
688 ztopofcell = zbottomofcell
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)
698 cs%var(cs%fldno)%p => f_ptr
702 deallocate(sp_val, mask_z)
704 end subroutine set_up_ale_sponge_field_varying
708 subroutine set_up_ale_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS)
711 real,
dimension(SZIB_(G),SZJ_(G),CS%nz_data), &
713 real,
dimension(SZI_(G),SZJB_(G),CS%nz_data), &
715 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
target,
intent(in) :: u_ptr
716 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
target,
intent(in) :: v_ptr
719 character(len=256) :: mesg
721 if (.not.
associated(cs))
return
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
728 cs%Ref_val_u%p(k,col) = u_val(cs%col_i_u(col),cs%col_j_u(col),k)
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
738 cs%Ref_val_v%p(k,col) = v_val(cs%col_i_v(col),cs%col_j_v(col),k)
744 end subroutine set_up_ale_sponge_vel_field_fixed
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
751 character(len=*),
intent(in) :: fieldname_u
752 character(len=*),
intent(in) :: filename_v
753 character(len=*),
intent(in) :: fieldname_v
754 type(time_type),
intent(in) :: Time
758 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
target,
intent(in) :: u_ptr
759 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
target,
intent(in) :: v_ptr
761 real,
allocatable,
dimension(:,:,:) :: u_val
762 real,
allocatable,
dimension(:,:,:) :: mask_u
763 real,
allocatable,
dimension(:,:,:) :: v_val
764 real,
allocatable,
dimension(:,:,:) :: mask_v
766 real,
allocatable,
dimension(:),
target :: z_in, z_edges_in
767 real :: missing_value
770 integer :: isd, ied, jsd, jed
771 integer :: isdB, iedB, jsdB, jedB
772 integer,
dimension(4) :: fld_sz
773 character(len=256) :: mesg
775 if (.not.
associated(cs))
return
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
784 cs%Ref_val_u%id = init_external_field(filename_u, fieldname_u)
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)
790 cs%Ref_val_v%id = init_external_field(filename_v, fieldname_v)
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)
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)) )
807 missing_value,.true.,.false.,.false., m_to_z=us%m_to_Z)
817 missing_value,.true.,.false.,.false., m_to_z=us%m_to_Z)
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
824 cs%Ref_val_u%p(k,col) = u_val(cs%col_i_u(col),cs%col_j_u(col),k)
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
834 cs%Ref_val_v%p(k,col) = v_val(cs%col_i_v(col),cs%col_j_v(col),k)
840 end subroutine set_up_ale_sponge_vel_field_varying
844 subroutine apply_ale_sponge(h, dt, G, GV, US, CS, Time)
848 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
850 real,
intent(in) :: dt
853 type(time_type),
optional,
intent(in) :: time
859 real,
allocatable,
dimension(:) :: tmp_val2
860 real,
dimension(SZK_(G)) :: tmp_val1
861 real :: hu(szib_(g), szj_(g), szk_(g))
862 real :: hv(szi_(g), szjb_(g), szk_(g))
863 real,
allocatable,
dimension(:,:,:) :: sp_val
864 real,
allocatable,
dimension(:,:,:) :: mask_z
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
870 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
872 if (.not.
associated(cs))
return
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
877 h_neglect = gv%kg_m2_to_H*1.0e-30 ; h_neglect_edge = gv%kg_m2_to_H*1.0e-10
880 if (cs%new_sponges)
then
881 if (.not.
present(time)) &
882 call mom_error(fatal,
"apply_ALE_sponge: No time information provided")
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))
894 missing_value,.true., .false.,.false., m_to_z=us%m_to_Z)
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)
905 if (cs%Ref_val(m)%h(k,c) <= 0.001*gv%m_to_H) &
908 cs%Ref_val(m)%p(k,c) = cs%Ref_val(m)%p(k-1,c)
912 deallocate(sp_val, mask_z)
918 allocate(tmp_val2(nz_data))
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)
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)
936 cs%var(m)%p(i,j,1:cs%nz) = i1pdamp * (cs%var(m)%p(i,j,1:cs%nz) + tmp_val1 * damp)
948 if (cs%sponge_uv)
then
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
955 if (cs%new_sponges)
then
956 if (.not.
present(time)) &
957 call mom_error(fatal,
"apply_ALE_sponge: No time information provided")
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))
964 missing_value, .true., .false., .false., m_to_z=us%m_to_Z)
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)
976 deallocate (sp_val, mask_z)
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))
983 missing_value, .true., .false., .false., m_to_z=us%m_to_Z)
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)
995 deallocate (sp_val, mask_z)
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)
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)
1015 cs%var_u%p(i,j,:) = i1pdamp * (cs%var_u%p(i,j,:) + tmp_val1 * damp)
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
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)
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)
1036 cs%var_v%p(i,j,:) = i1pdamp * (cs%var_v%p(i,j,:) + tmp_val1 * damp)
1041 deallocate(tmp_val2)
1043 end subroutine apply_ale_sponge
1048 subroutine ale_sponge_end(CS)
1054 if (.not.
associated(cs))
return
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)
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)
1068 if (
associated(cs%Ref_val(cs%fldno)%p))
deallocate(cs%Ref_val(cs%fldno)%p)
1073 end subroutine ale_sponge_end