12 use coupler_types_mod,
only : coupler_1d_bc_type, coupler_2d_bc_type
13 use coupler_types_mod,
only : coupler_type_spawn, coupler_type_destructor
15 implicit none ;
private
17 #include <MOM_memory.h>
29 real,
dimension(:,:,:),
pointer :: p => null()
33 real,
dimension(:,:),
pointer :: p => null()
39 real,
allocatable,
dimension(:,:) :: &
40 sst, & !< The sea surface temperature [degC].
41 sss, & !< The sea surface salinity [ppt ~> psu or gSalt/kg].
42 sfc_density, & !< The mixed layer density [kg m-3].
43 hml, & !< The mixed layer depth [m].
44 u, & !< The mixed layer zonal velocity [m s-1].
45 v, & !< The mixed layer meridional velocity [m s-1].
46 sea_lev, & !< The sea level [m]. If a reduced surface gravity is
61 logical :: t_is_cont = .false.
63 logical :: s_is_abss = .false.
65 real,
pointer,
dimension(:,:) :: frazil => null()
68 type(coupler_2d_bc_type) :: tr_fields
72 logical :: arrays_allocated = .false.
80 real,
pointer :: t(:,:,:) => null()
81 real,
pointer :: s(:,:,:) => null()
82 type(
eos_type),
pointer :: eqn_of_state => null()
90 logical :: t_is_cont = .false.
92 logical :: s_is_abss = .false.
94 real :: min_salinity = 0.01
97 real,
dimension(:,:),
pointer :: frazil => null()
101 real,
dimension(:,:),
pointer :: salt_deficit => null()
105 real,
dimension(:,:),
pointer :: tempxpme => null()
111 real,
dimension(:,:),
pointer :: internal_heat => null()
123 real,
pointer,
dimension(:,:,:) :: &
129 real,
pointer,
dimension(:,:,:) :: &
132 real,
pointer,
dimension(:,:,:) :: &
141 u_accel_bt => null(), &
143 real,
pointer,
dimension(:,:,:) :: &
154 real,
pointer,
dimension(:,:,:) :: &
161 du_dt_visc => null(), &
162 dv_dt_visc => null(), &
163 du_dt_dia => null(), &
165 real,
pointer,
dimension(:,:,:) :: du_other => null()
168 real,
pointer,
dimension(:,:,:) :: dv_other => null()
173 real,
pointer :: gradkeu(:,:,:) => null()
174 real,
pointer :: gradkev(:,:,:) => null()
175 real,
pointer :: rv_x_v(:,:,:) => null()
176 real,
pointer :: rv_x_u(:,:,:) => null()
184 real,
pointer,
dimension(:,:,:) :: &
191 real,
pointer :: diapyc_vel(:,:,:) => null()
199 real,
pointer,
dimension(:,:) :: &
200 bbl_thick_u => null(), &
201 bbl_thick_v => null(), &
202 kv_bbl_u => null(), &
203 kv_bbl_v => null(), &
205 real,
pointer,
dimension(:,:) :: tke_bbl => null()
209 real,
pointer,
dimension(:,:) :: &
210 taux_shelf => null(), &
212 real,
pointer,
dimension(:,:) :: tbl_thick_shelf_u => null()
214 real,
pointer,
dimension(:,:) :: tbl_thick_shelf_v => null()
216 real,
pointer,
dimension(:,:) :: kv_tbl_shelf_u => null()
218 real,
pointer,
dimension(:,:) :: kv_tbl_shelf_v => null()
220 real,
pointer,
dimension(:,:) :: nkml_visc_u => null()
225 real,
pointer,
dimension(:,:) :: nkml_visc_v => null()
227 real,
pointer,
dimension(:,:) :: &
229 real,
pointer,
dimension(:,:,:) :: &
232 real,
pointer,
dimension(:,:,:) :: kd_extra_t => null()
235 real,
pointer,
dimension(:,:,:) :: kd_extra_s => null()
241 real,
pointer,
dimension(:,:,:) :: kd_shear => null()
244 real,
pointer,
dimension(:,:,:) :: kv_shear => null()
247 real,
pointer,
dimension(:,:,:) :: kv_shear_bu => null()
250 real,
pointer,
dimension(:,:,:) :: kv_slow => null()
253 real,
pointer,
dimension(:,:,:) :: tke_turb => null()
261 real,
allocatable :: fa_u_ee(:,:)
263 real,
allocatable :: fa_u_e0(:,:)
265 real,
allocatable :: fa_u_w0(:,:)
267 real,
allocatable :: fa_u_ww(:,:)
269 real,
allocatable :: ubt_ww(:,:)
271 real,
allocatable :: ubt_ee(:,:)
273 real,
allocatable :: fa_v_nn(:,:)
275 real,
allocatable :: fa_v_n0(:,:)
277 real,
allocatable :: fa_v_s0(:,:)
279 real,
allocatable :: fa_v_ss(:,:)
281 real,
allocatable :: vbt_ss(:,:)
283 real,
allocatable :: vbt_nn(:,:)
285 real,
allocatable :: h_u(:,:,:)
286 real,
allocatable :: h_v(:,:,:)
287 type(group_pass_type) :: pass_polarity_bt
288 type(group_pass_type) :: pass_fa_uv
296 gas_fields_ocn, use_meltpot, use_iceshelves)
298 type(
surface),
intent(inout) :: sfc_state
299 logical,
optional,
intent(in) :: use_temperature
300 logical,
optional,
intent(in) :: do_integrals
302 type(coupler_1d_bc_type), &
303 optional,
intent(in) :: gas_fields_ocn
308 logical,
optional,
intent(in) :: use_meltpot
309 logical,
optional,
intent(in) :: use_iceshelves
313 logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves
314 integer :: is, ie, js, je, isd, ied, jsd, jed
315 integer :: isdb, iedb, jsdb, jedb
317 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
318 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
319 isdb = g%isdB ; iedb = g%iedB; jsdb = g%jsdB ; jedb = g%jedB
321 use_temp = .true. ;
if (
present(use_temperature)) use_temp = use_temperature
322 alloc_integ = .true. ;
if (
present(do_integrals)) alloc_integ = do_integrals
323 use_melt_potential = .false. ;
if (
present(use_meltpot)) use_melt_potential = use_meltpot
324 alloc_iceshelves = .false. ;
if (
present(use_iceshelves)) alloc_iceshelves = use_iceshelves
326 if (sfc_state%arrays_allocated)
return
329 allocate(sfc_state%SST(isd:ied,jsd:jed)) ; sfc_state%SST(:,:) = 0.0
330 allocate(sfc_state%SSS(isd:ied,jsd:jed)) ; sfc_state%SSS(:,:) = 0.0
332 allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0
334 allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0
335 allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0
336 allocate(sfc_state%u(isdb:iedb,jsd:jed)) ; sfc_state%u(:,:) = 0.0
337 allocate(sfc_state%v(isd:ied,jsdb:jedb)) ; sfc_state%v(:,:) = 0.0
339 if (use_melt_potential)
then
340 allocate(sfc_state%melt_potential(isd:ied,jsd:jed)) ; sfc_state%melt_potential(:,:) = 0.0
343 if (alloc_integ)
then
345 allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0
347 allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0
348 allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0
349 allocate(sfc_state%TempxPmE(isd:ied,jsd:jed)) ; sfc_state%TempxPmE(:,:) = 0.0
350 allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0
351 allocate(sfc_state%internal_heat(isd:ied,jsd:jed)) ; sfc_state%internal_heat(:,:) = 0.0
355 if (alloc_iceshelves)
then
356 allocate(sfc_state%taux_shelf(isdb:iedb,jsd:jed)) ; sfc_state%taux_shelf(:,:) = 0.0
357 allocate(sfc_state%tauy_shelf(isd:ied,jsdb:jedb)) ; sfc_state%tauy_shelf(:,:) = 0.0
360 if (
present(gas_fields_ocn)) &
361 call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, &
362 (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
364 sfc_state%arrays_allocated = .true.
372 if (.not.sfc_state%arrays_allocated)
return
374 if (
allocated(sfc_state%melt_potential))
deallocate(sfc_state%melt_potential)
375 if (
allocated(sfc_state%SST))
deallocate(sfc_state%SST)
376 if (
allocated(sfc_state%SSS))
deallocate(sfc_state%SSS)
377 if (
allocated(sfc_state%sfc_density))
deallocate(sfc_state%sfc_density)
378 if (
allocated(sfc_state%sea_lev))
deallocate(sfc_state%sea_lev)
379 if (
allocated(sfc_state%Hml))
deallocate(sfc_state%Hml)
380 if (
allocated(sfc_state%u))
deallocate(sfc_state%u)
381 if (
allocated(sfc_state%v))
deallocate(sfc_state%v)
382 if (
allocated(sfc_state%ocean_mass))
deallocate(sfc_state%ocean_mass)
383 if (
allocated(sfc_state%ocean_heat))
deallocate(sfc_state%ocean_heat)
384 if (
allocated(sfc_state%ocean_salt))
deallocate(sfc_state%ocean_salt)
385 if (
allocated(sfc_state%salt_deficit))
deallocate(sfc_state%salt_deficit)
387 call coupler_type_destructor(sfc_state%tr_fields)
389 sfc_state%arrays_allocated = .false.
397 logical,
optional,
intent(in) :: alloc_faces
400 integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
401 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
402 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
404 if (
associated(bt_cont))
call mom_error(fatal, &
405 "alloc_BT_cont_type called with an associated BT_cont_type pointer.")
408 allocate(bt_cont%FA_u_WW(isdb:iedb,jsd:jed)) ; bt_cont%FA_u_WW(:,:) = 0.0
409 allocate(bt_cont%FA_u_W0(isdb:iedb,jsd:jed)) ; bt_cont%FA_u_W0(:,:) = 0.0
410 allocate(bt_cont%FA_u_E0(isdb:iedb,jsd:jed)) ; bt_cont%FA_u_E0(:,:) = 0.0
411 allocate(bt_cont%FA_u_EE(isdb:iedb,jsd:jed)) ; bt_cont%FA_u_EE(:,:) = 0.0
412 allocate(bt_cont%uBT_WW(isdb:iedb,jsd:jed)) ; bt_cont%uBT_WW(:,:) = 0.0
413 allocate(bt_cont%uBT_EE(isdb:iedb,jsd:jed)) ; bt_cont%uBT_EE(:,:) = 0.0
415 allocate(bt_cont%FA_v_SS(isd:ied,jsdb:jedb)) ; bt_cont%FA_v_SS(:,:) = 0.0
416 allocate(bt_cont%FA_v_S0(isd:ied,jsdb:jedb)) ; bt_cont%FA_v_S0(:,:) = 0.0
417 allocate(bt_cont%FA_v_N0(isd:ied,jsdb:jedb)) ; bt_cont%FA_v_N0(:,:) = 0.0
418 allocate(bt_cont%FA_v_NN(isd:ied,jsdb:jedb)) ; bt_cont%FA_v_NN(:,:) = 0.0
419 allocate(bt_cont%vBT_SS(isd:ied,jsdb:jedb)) ; bt_cont%vBT_SS(:,:) = 0.0
420 allocate(bt_cont%vBT_NN(isd:ied,jsdb:jedb)) ; bt_cont%vBT_NN(:,:) = 0.0
422 if (
present(alloc_faces))
then ;
if (alloc_faces)
then
423 allocate(bt_cont%h_u(isdb:iedb,jsd:jed,1:g%ke)) ; bt_cont%h_u(:,:,:) = 0.0
424 allocate(bt_cont%h_v(isd:ied,jsdb:jedb,1:g%ke)) ; bt_cont%h_v(:,:,:) = 0.0
433 if (.not.
associated(bt_cont))
return
435 deallocate(bt_cont%FA_u_WW) ;
deallocate(bt_cont%FA_u_W0)
436 deallocate(bt_cont%FA_u_E0) ;
deallocate(bt_cont%FA_u_EE)
437 deallocate(bt_cont%uBT_WW) ;
deallocate(bt_cont%uBT_EE)
439 deallocate(bt_cont%FA_v_SS) ;
deallocate(bt_cont%FA_v_S0)
440 deallocate(bt_cont%FA_v_N0) ;
deallocate(bt_cont%FA_v_NN)
441 deallocate(bt_cont%vBT_SS) ;
deallocate(bt_cont%vBT_NN)
443 if (
allocated(bt_cont%h_u))
deallocate(bt_cont%h_u)
444 if (
allocated(bt_cont%h_v))
deallocate(bt_cont%h_v)
452 character(len=*),
intent(in) :: mesg
459 if (
associated(tv%T)) &
460 call hchksum(tv%T, mesg//
" tv%T", g%HI)
461 if (
associated(tv%S)) &
462 call hchksum(tv%S, mesg//
" tv%S", g%HI)
463 if (
associated(tv%frazil)) &
464 call hchksum(tv%frazil, mesg//
" tv%frazil", g%HI)
465 if (
associated(tv%salt_deficit)) &
466 call hchksum(tv%salt_deficit, mesg//
" tv%salt_deficit", g%HI, scale=g%US%R_to_kg_m3*g%US%Z_to_m)
467 if (
associated(tv%TempxPmE)) &
468 call hchksum(tv%TempxPmE, mesg//
" tv%TempxPmE", g%HI, scale=g%US%R_to_kg_m3*g%US%Z_to_m)