16 use mom_diag_mediator,
only : diag_save_grids, diag_restore_grids, diag_copy_storage_to_diag
20 use mom_eos,
only : gsw_sp_from_sr, gsw_pt_from_ct
33 use coupler_types_mod,
only : coupler_type_send_data
35 implicit none ;
private 37 #include <MOM_memory.h> 39 public calculate_diagnostic_fields, register_time_deriv, write_static_fields
41 public register_surface_diags, post_surface_dyn_diags, post_surface_thermo_diags
42 public register_transport_diags, post_transport_diagnostics
43 public mom_diagnostics_init, mom_diagnostics_end
52 real :: mono_n2_column_fraction = 0.
55 real :: mono_n2_depth = -1.
64 real,
pointer,
dimension(:,:,:) :: &
69 real,
pointer,
dimension(:,:,:) :: &
78 real,
pointer,
dimension(:,:,:) :: h_rlay => null()
80 real,
pointer,
dimension(:,:,:) :: uh_rlay => null()
82 real,
pointer,
dimension(:,:,:) :: vh_rlay => null()
84 real,
pointer,
dimension(:,:,:) :: uhgm_rlay => null()
86 real,
pointer,
dimension(:,:,:) :: vhgm_rlay => null()
90 real,
pointer,
dimension(:,:) :: &
94 cfl_cg1_x => null(), &
98 real,
pointer,
dimension(:,:,:) :: &
101 pe_to_ke => null(), &
102 ke_coradv => null(), &
109 ke_horvisc => null(), &
113 integer :: id_u = -1, id_v = -1, id_h = -1
114 integer :: id_e = -1, id_e_d = -1
115 integer :: id_du_dt = -1, id_dv_dt = -1
117 integer :: id_hf_du_dt_2d = -1, id_hf_dv_dt_2d = -1
118 integer :: id_col_ht = -1, id_dh_dt = -1
119 integer :: id_ke = -1, id_dkedt = -1
120 integer :: id_pe_to_ke = -1, id_ke_coradv = -1
121 integer :: id_ke_adv = -1, id_ke_visc = -1
122 integer :: id_ke_horvisc = -1, id_ke_dia = -1
123 integer :: id_uh_rlay = -1, id_vh_rlay = -1
124 integer :: id_uhgm_rlay = -1, id_vhgm_rlay = -1
125 integer :: id_h_rlay = -1, id_rd1 = -1
126 integer :: id_rml = -1, id_rcv = -1
127 integer :: id_cg1 = -1, id_cfl_cg1 = -1
128 integer :: id_cfl_cg1_x = -1, id_cfl_cg1_y = -1
129 integer :: id_cg_ebt = -1, id_rd_ebt = -1
130 integer :: id_p_ebt = -1
131 integer :: id_temp_int = -1, id_salt_int = -1
132 integer :: id_mass_wt = -1, id_col_mass = -1
133 integer :: id_masscello = -1, id_masso = -1
134 integer :: id_volcello = -1
135 integer :: id_tpot = -1, id_sprac = -1
136 integer :: id_tob = -1, id_sob = -1
137 integer :: id_thetaoga = -1, id_soga = -1
138 integer :: id_sosga = -1, id_tosga = -1
139 integer :: id_temp_layer_ave = -1, id_salt_layer_ave = -1
140 integer :: id_pbo = -1
141 integer :: id_thkcello = -1, id_rhoinsitu = -1
142 integer :: id_rhopot0 = -1, id_rhopot2 = -1
143 integer :: id_drho_dt = -1, id_drho_ds = -1
144 integer :: id_h_pre_sync = -1
149 type(
p3d) :: var_ptr(max_fields_)
151 type(
p3d) :: deriv(max_fields_)
152 type(
p3d) :: prev_val(max_fields_)
155 integer :: nlay(max_fields_)
156 integer :: num_time_deriv = 0
158 type(group_pass_type) :: pass_ke_uv
167 integer :: id_zos = -1, id_zossq = -1
168 integer :: id_volo = -1, id_speed = -1
169 integer :: id_ssh = -1, id_ssh_ga = -1
170 integer :: id_sst = -1, id_sst_sq = -1, id_sstcon = -1
171 integer :: id_sss = -1, id_sss_sq = -1, id_sssabs = -1
172 integer :: id_ssu = -1, id_ssv = -1
175 integer :: id_fraz = -1
176 integer :: id_salt_deficit = -1
177 integer :: id_heat_pme = -1
178 integer :: id_intern_heat = -1
186 integer :: id_uhtr = -1, id_umo = -1, id_umo_2d = -1
187 integer :: id_vhtr = -1, id_vmo = -1, id_vmo_2d = -1
188 integer :: id_dynamics_h = -1, id_dynamics_h_tendency = -1
195 subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
196 dt, diag_pre_sync, G, GV, US, CS, eta_bt)
200 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
202 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
204 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
206 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
209 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
218 real,
dimension(:,:),
pointer :: p_surf
221 real,
intent(in) :: dt
226 real,
dimension(SZI_(G),SZJ_(G)), &
227 optional,
intent(in) :: eta_bt
233 integer,
dimension(2) :: eosdom
234 integer i, j, k, is, ie, js, je, isq, ieq, jsq, jeq, nz, nkmb
236 real :: rcv(szi_(g),szj_(g),szk_(g))
237 real :: work_3d(szi_(g),szj_(g),szk_(g))
238 real :: work_2d(szi_(g),szj_(g))
239 real :: rho_in_situ(szi_(g))
241 real,
allocatable,
dimension(:,:) :: &
242 hf_du_dt_2d, hf_dv_dt_2d
245 real :: surface_field(szi_(g),szj_(g))
246 real :: pressure_1d(szi_(g))
251 real :: absurdly_small_freq2
255 real,
dimension(SZK_(G)) :: temp_layer_ave, salt_layer_ave
256 real :: thetaoga, soga, masso, tosga, sosga
258 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
259 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
260 nz = g%ke ; nkmb = gv%nk_rho_varies
263 absurdly_small_freq2 = 1e-34*us%T_to_s**2
265 if (loc(cs)==0)
call mom_error(fatal, &
266 "calculate_diagnostic_fields: Module must be initialized before used.")
268 call calculate_derivs(dt, g, cs)
271 call diag_save_grids(cs%diag)
272 call diag_copy_storage_to_diag(cs%diag, diag_pre_sync)
274 if (cs%id_h_pre_sync > 0) &
275 call post_data(cs%id_h_pre_sync, diag_pre_sync%h_state, cs%diag, alt_h = diag_pre_sync%h_state)
277 if (cs%id_du_dt>0)
call post_data(cs%id_du_dt, cs%du_dt, cs%diag, alt_h = diag_pre_sync%h_state)
279 if (cs%id_dv_dt>0)
call post_data(cs%id_dv_dt, cs%dv_dt, cs%diag, alt_h = diag_pre_sync%h_state)
281 if (cs%id_dh_dt>0)
call post_data(cs%id_dh_dt, cs%dh_dt, cs%diag, alt_h = diag_pre_sync%h_state)
301 if (cs%id_hf_du_dt_2d > 0)
then 302 allocate(hf_du_dt_2d(g%IsdB:g%IedB,g%jsd:g%jed))
303 hf_du_dt_2d(:,:) = 0.0
304 do k=1,nz ;
do j=js,je ;
do i=isq,ieq
305 hf_du_dt_2d(i,j) = hf_du_dt_2d(i,j) + cs%du_dt(i,j,k) * adp%diag_hfrac_u(i,j,k)
306 enddo ;
enddo ;
enddo 307 call post_data(cs%id_hf_du_dt_2d, hf_du_dt_2d, cs%diag)
308 deallocate(hf_du_dt_2d)
311 if (cs%id_hf_dv_dt_2d > 0)
then 312 allocate(hf_dv_dt_2d(g%isd:g%ied,g%JsdB:g%JedB))
313 hf_dv_dt_2d(:,:) = 0.0
314 do k=1,nz ;
do j=jsq,jeq ;
do i=is,ie
315 hf_dv_dt_2d(i,j) = hf_dv_dt_2d(i,j) + cs%dv_dt(i,j,k) * adp%diag_hfrac_v(i,j,k)
316 enddo ;
enddo ;
enddo 317 call post_data(cs%id_hf_dv_dt_2d, hf_dv_dt_2d, cs%diag)
318 deallocate(hf_dv_dt_2d)
321 call diag_restore_grids(cs%diag)
323 call calculate_energy_diagnostics(u, v, h, uh, vh, adp, cdp, g, gv, us, cs)
332 if (nkmb==0 .and. nz > 1) nkmb = nz
334 if (cs%id_u > 0)
call post_data(cs%id_u, u, cs%diag)
336 if (cs%id_v > 0)
call post_data(cs%id_v, v, cs%diag)
338 if (cs%id_h > 0)
call post_data(cs%id_h, h, cs%diag)
340 if (
associated(cs%e))
then 341 call find_eta(h, tv, g, gv, us, cs%e, eta_bt)
342 if (cs%id_e > 0)
call post_data(cs%id_e, cs%e, cs%diag)
345 if (
associated(cs%e_D))
then 346 if (
associated(cs%e))
then 347 do k=1,nz+1 ;
do j=js,je ;
do i=is,ie
348 cs%e_D(i,j,k) = cs%e(i,j,k) + g%bathyT(i,j)
349 enddo ;
enddo ;
enddo 351 call find_eta(h, tv, g, gv, us, cs%e_D, eta_bt)
352 do k=1,nz+1 ;
do j=js,je ;
do i=is,ie
353 cs%e_D(i,j,k) = cs%e_D(i,j,k) + g%bathyT(i,j)
354 enddo ;
enddo ;
enddo 357 if (cs%id_e_D > 0)
call post_data(cs%id_e_D, cs%e_D, cs%diag)
361 if (cs%id_masscello > 0)
then 362 do k=1,nz;
do j=js,je ;
do i=is,ie
363 work_3d(i,j,k) = gv%H_to_kg_m2*h(i,j,k)
364 enddo ;
enddo ;
enddo 365 call post_data(cs%id_masscello, work_3d, cs%diag)
369 if (cs%id_masso > 0)
then 371 do k=1,nz ;
do j=js,je ;
do i=is,ie
372 work_2d(i,j) = work_2d(i,j) + (gv%H_to_kg_m2*h(i,j,k)) * us%L_to_m**2*g%areaT(i,j)
373 enddo ;
enddo ;
enddo 375 call post_data(cs%id_masso, masso, cs%diag)
379 if (cs%id_thkcello>0 .or. cs%id_volcello>0)
then 380 if (gv%Boussinesq)
then 381 if (cs%id_thkcello > 0)
then ;
if (gv%H_to_Z == 1.0)
then 382 call post_data(cs%id_thkcello, h, cs%diag)
384 do k=1,nz;
do j=js,je ;
do i=is,ie
385 work_3d(i,j,k) = gv%H_to_Z*h(i,j,k)
386 enddo ;
enddo ;
enddo 387 call post_data(cs%id_thkcello, work_3d, cs%diag)
389 if (cs%id_volcello > 0)
then 390 do k=1,nz;
do j=js,je ;
do i=is,ie
391 work_3d(i,j,k) = ( gv%H_to_Z*h(i,j,k) ) * us%Z_to_m*us%L_to_m**2*g%areaT(i,j)
392 enddo ;
enddo ;
enddo 393 call post_data(cs%id_volcello, work_3d, cs%diag)
396 eosdom(:) = eos_domain(g%HI)
398 if (
associated(p_surf))
then 400 pressure_1d(i) = p_surf(i,j)
409 pressure_1d(i) = pressure_1d(i) + 0.5*(gv%H_to_RZ*gv%g_Earth)*h(i,j,k)
413 tv%eqn_of_state, eosdom)
415 work_3d(i,j,k) = (gv%H_to_RZ*h(i,j,k)) / rho_in_situ(i)
418 pressure_1d(i) = pressure_1d(i) + 0.5*(gv%H_to_RZ*gv%g_Earth)*h(i,j,k)
422 if (cs%id_thkcello > 0)
call post_data(cs%id_thkcello, work_3d, cs%diag)
423 if (cs%id_volcello > 0)
then 424 do k=1,nz;
do j=js,je ;
do i=is,ie
425 work_3d(i,j,k) = us%Z_to_m*us%L_to_m**2*g%areaT(i,j) * work_3d(i,j,k)
426 enddo ;
enddo ;
enddo 427 call post_data(cs%id_volcello, work_3d, cs%diag)
433 if (tv%T_is_conT)
then 437 if ((cs%id_Tpot > 0) .or. (cs%id_tob > 0))
then 438 do k=1,nz ;
do j=js,je ;
do i=is,ie
439 work_3d(i,j,k) = gsw_pt_from_ct(tv%S(i,j,k),tv%T(i,j,k))
440 enddo ;
enddo ;
enddo 441 if (cs%id_Tpot > 0)
call post_data(cs%id_Tpot, work_3d, cs%diag)
442 if (cs%id_tob > 0)
call post_data(cs%id_tob, work_3d(:,:,nz), cs%diag, mask=g%mask2dT)
446 if (cs%id_tob > 0)
call post_data(cs%id_tob, tv%T(:,:,nz), cs%diag, mask=g%mask2dT)
450 if (tv%S_is_absS)
then 454 if ((cs%id_Sprac > 0) .or. (cs%id_sob > 0))
then 455 do k=1,nz ;
do j=js,je ;
do i=is,ie
456 work_3d(i,j,k) = gsw_sp_from_sr(tv%S(i,j,k))
457 enddo ;
enddo ;
enddo 458 if (cs%id_Sprac > 0)
call post_data(cs%id_Sprac, work_3d, cs%diag)
459 if (cs%id_sob > 0)
call post_data(cs%id_sob, work_3d(:,:,nz), cs%diag, mask=g%mask2dT)
463 if (cs%id_sob > 0)
call post_data(cs%id_sob, tv%S(:,:,nz), cs%diag, mask=g%mask2dT)
467 if (cs%id_thetaoga>0)
then 468 thetaoga = global_volume_mean(tv%T, h, g, gv)
469 call post_data(cs%id_thetaoga, thetaoga, cs%diag)
473 if (cs%id_tosga > 0)
then 474 do j=js,je ;
do i=is,ie
475 surface_field(i,j) = tv%T(i,j,1)
477 tosga = global_area_mean(surface_field, g)
478 call post_data(cs%id_tosga, tosga, cs%diag)
482 if (cs%id_soga>0)
then 483 soga = global_volume_mean(tv%S, h, g, gv)
484 call post_data(cs%id_soga, soga, cs%diag)
488 if (cs%id_sosga > 0)
then 489 do j=js,je ;
do i=is,ie
490 surface_field(i,j) = tv%S(i,j,1)
492 sosga = global_area_mean(surface_field, g)
493 call post_data(cs%id_sosga, sosga, cs%diag)
497 if (cs%id_temp_layer_ave>0)
then 498 temp_layer_ave = global_layer_mean(tv%T, h, g, gv)
499 call post_data(cs%id_temp_layer_ave, temp_layer_ave, cs%diag)
503 if (cs%id_salt_layer_ave>0)
then 504 salt_layer_ave = global_layer_mean(tv%S, h, g, gv)
505 call post_data(cs%id_salt_layer_ave, salt_layer_ave, cs%diag)
508 call calculate_vertical_integrals(h, tv, p_surf, g, gv, us, cs)
510 if ((cs%id_Rml > 0) .or. (cs%id_Rcv > 0) .or.
associated(cs%h_Rlay) .or. &
511 associated(cs%uh_Rlay) .or.
associated(cs%vh_Rlay) .or. &
512 associated(cs%uhGM_Rlay) .or.
associated(cs%vhGM_Rlay))
then 514 if (
associated(tv%eqn_of_state))
then 515 eosdom(:) = eos_domain(g%HI, halo=1)
516 pressure_1d(:) = tv%P_Ref
518 do k=1,nz ;
do j=js-1,je+1
519 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rcv(:,j,k), tv%eqn_of_state, &
523 do k=1,nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
524 rcv(i,j,k) = gv%Rlay(k)
525 enddo ;
enddo ;
enddo 527 if (cs%id_Rml > 0)
call post_data(cs%id_Rml, rcv, cs%diag)
528 if (cs%id_Rcv > 0)
call post_data(cs%id_Rcv, rcv, cs%diag)
530 if (
associated(cs%h_Rlay))
then 535 do k=1,nkmb ;
do i=is,ie
536 cs%h_Rlay(i,j,k) = 0.0
538 do k=nkmb+1,nz ;
do i=is,ie
539 cs%h_Rlay(i,j,k) = h(i,j,k)
541 do k=1,nkmb ;
do i=is,ie
542 call find_weights(gv%Rlay, rcv(i,j,k), k_list, nz, wt, wt_p)
543 cs%h_Rlay(i,j,k_list) = cs%h_Rlay(i,j,k_list) + h(i,j,k)*wt
544 cs%h_Rlay(i,j,k_list+1) = cs%h_Rlay(i,j,k_list+1) + h(i,j,k)*wt_p
548 if (cs%id_h_Rlay > 0)
call post_data(cs%id_h_Rlay, cs%h_Rlay, cs%diag)
551 if (
associated(cs%uh_Rlay))
then 556 do k=1,nkmb ;
do i=isq,ieq
557 cs%uh_Rlay(i,j,k) = 0.0
559 do k=nkmb+1,nz ;
do i=isq,ieq
560 cs%uh_Rlay(i,j,k) = uh(i,j,k)
563 do k=1,nkmb ;
do i=isq,ieq
564 call find_weights(gv%Rlay, 0.5*(rcv(i,j,k)+rcv(i+1,j,k)), k_list, nz, wt, wt_p)
565 cs%uh_Rlay(i,j,k_list) = cs%uh_Rlay(i,j,k_list) + uh(i,j,k)*wt
566 cs%uh_Rlay(i,j,k_list+1) = cs%uh_Rlay(i,j,k_list+1) + uh(i,j,k)*wt_p
570 if (cs%id_uh_Rlay > 0)
call post_data(cs%id_uh_Rlay, cs%uh_Rlay, cs%diag)
573 if (
associated(cs%vh_Rlay))
then 578 do k=1,nkmb ;
do i=is,ie
579 cs%vh_Rlay(i,j,k) = 0.0
581 do k=nkmb+1,nz ;
do i=is,ie
582 cs%vh_Rlay(i,j,k) = vh(i,j,k)
584 do k=1,nkmb ;
do i=is,ie
585 call find_weights(gv%Rlay, 0.5*(rcv(i,j,k)+rcv(i,j+1,k)), k_list, nz, wt, wt_p)
586 cs%vh_Rlay(i,j,k_list) = cs%vh_Rlay(i,j,k_list) + vh(i,j,k)*wt
587 cs%vh_Rlay(i,j,k_list+1) = cs%vh_Rlay(i,j,k_list+1) + vh(i,j,k)*wt_p
591 if (cs%id_vh_Rlay > 0)
call post_data(cs%id_vh_Rlay, cs%vh_Rlay, cs%diag)
594 if (
associated(cs%uhGM_Rlay) .and.
associated(cdp%uhGM))
then 599 do k=1,nkmb ;
do i=isq,ieq
600 cs%uhGM_Rlay(i,j,k) = 0.0
602 do k=nkmb+1,nz ;
do i=isq,ieq
603 cs%uhGM_Rlay(i,j,k) = cdp%uhGM(i,j,k)
605 do k=1,nkmb ;
do i=isq,ieq
606 call find_weights(gv%Rlay, 0.5*(rcv(i,j,k)+rcv(i+1,j,k)), k_list, nz, wt, wt_p)
607 cs%uhGM_Rlay(i,j,k_list) = cs%uhGM_Rlay(i,j,k_list) + cdp%uhGM(i,j,k)*wt
608 cs%uhGM_Rlay(i,j,k_list+1) = cs%uhGM_Rlay(i,j,k_list+1) + cdp%uhGM(i,j,k)*wt_p
612 if (cs%id_uhGM_Rlay > 0)
call post_data(cs%id_uhGM_Rlay, cs%uhGM_Rlay, cs%diag)
615 if (
associated(cs%vhGM_Rlay) .and.
associated(cdp%vhGM))
then 620 do k=1,nkmb ;
do i=is,ie
621 cs%vhGM_Rlay(i,j,k) = 0.0
623 do k=nkmb+1,nz ;
do i=is,ie
624 cs%vhGM_Rlay(i,j,k) = cdp%vhGM(i,j,k)
626 do k=1,nkmb ;
do i=is,ie
627 call find_weights(gv%Rlay, 0.5*(rcv(i,j,k)+rcv(i,j+1,k)), k_list, nz, wt, wt_p)
628 cs%vhGM_Rlay(i,j,k_list) = cs%vhGM_Rlay(i,j,k_list) + cdp%vhGM(i,j,k)*wt
629 cs%vhGM_Rlay(i,j,k_list+1) = cs%vhGM_Rlay(i,j,k_list+1) + cdp%vhGM(i,j,k)*wt_p
633 if (cs%id_vhGM_Rlay > 0)
call post_data(cs%id_vhGM_Rlay, cs%vhGM_Rlay, cs%diag)
637 if (
associated(tv%eqn_of_state))
then 638 eosdom(:) = eos_domain(g%HI)
639 if (cs%id_rhopot0 > 0)
then 642 do k=1,nz ;
do j=js,je
643 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rcv(:,j,k), &
644 tv%eqn_of_state, eosdom)
646 if (cs%id_rhopot0 > 0)
call post_data(cs%id_rhopot0, rcv, cs%diag)
648 if (cs%id_rhopot2 > 0)
then 649 pressure_1d(:) = 2.0e7*us%kg_m3_to_R*us%m_s_to_L_T**2
651 do k=1,nz ;
do j=js,je
652 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rcv(:,j,k), &
653 tv%eqn_of_state, eosdom)
655 if (cs%id_rhopot2 > 0)
call post_data(cs%id_rhopot2, rcv, cs%diag)
657 if (cs%id_rhoinsitu > 0)
then 662 pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (gv%H_to_RZ*gv%g_Earth)
663 call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pressure_1d, rcv(:,j,k), &
664 tv%eqn_of_state, eosdom)
665 pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * (gv%H_to_RZ*gv%g_Earth)
668 if (cs%id_rhoinsitu > 0)
call post_data(cs%id_rhoinsitu, rcv, cs%diag)
671 if (cs%id_drho_dT > 0 .or. cs%id_drho_dS > 0)
then 676 pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * gv%H_to_Pa
679 rcv(:,j,k),work_3d(:,j,k),is,ie-is+1, tv%eqn_of_state)
680 pressure_1d(:) = pressure_1d(:) + 0.5 * h(:,j,k) * gv%H_to_Pa
683 if (cs%id_drho_dT > 0)
call post_data(cs%id_drho_dT, rcv, cs%diag)
684 if (cs%id_drho_dS > 0)
call post_data(cs%id_drho_dS, work_3d, cs%diag)
688 if ((cs%id_cg1>0) .or. (cs%id_Rd1>0) .or. (cs%id_cfl_cg1>0) .or. &
689 (cs%id_cfl_cg1_x>0) .or. (cs%id_cfl_cg1_y>0))
then 690 call wave_speed(h, tv, g, gv, us, cs%cg1, cs%wave_speed_CSp)
691 if (cs%id_cg1>0)
call post_data(cs%id_cg1, cs%cg1, cs%diag)
692 if (cs%id_Rd1>0)
then 694 do j=js,je ;
do i=is,ie
696 f2_h = absurdly_small_freq2 + 0.25 * &
697 ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
698 (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2))
699 mag_beta = sqrt(0.5 * ( &
700 (((g%CoriolisBu(i,j)-g%CoriolisBu(i-1,j)) * g%IdxCv(i,j))**2 + &
701 ((g%CoriolisBu(i,j-1)-g%CoriolisBu(i-1,j-1)) * g%IdxCv(i,j-1))**2) + &
702 (((g%CoriolisBu(i,j)-g%CoriolisBu(i,j-1)) * g%IdyCu(i,j))**2 + &
703 ((g%CoriolisBu(i-1,j)-g%CoriolisBu(i-1,j-1)) * g%IdyCu(i-1,j))**2) ))
704 cs%Rd1(i,j) = cs%cg1(i,j) / sqrt(f2_h + cs%cg1(i,j) * mag_beta)
707 call post_data(cs%id_Rd1, cs%Rd1, cs%diag)
709 if (cs%id_cfl_cg1>0)
then 710 do j=js,je ;
do i=is,ie
711 cs%cfl_cg1(i,j) = (dt*cs%cg1(i,j)) * (g%IdxT(i,j) + g%IdyT(i,j))
713 call post_data(cs%id_cfl_cg1, cs%cfl_cg1, cs%diag)
715 if (cs%id_cfl_cg1_x>0)
then 716 do j=js,je ;
do i=is,ie
717 cs%cfl_cg1_x(i,j) = (dt*cs%cg1(i,j)) * g%IdxT(i,j)
719 call post_data(cs%id_cfl_cg1_x, cs%cfl_cg1_x, cs%diag)
721 if (cs%id_cfl_cg1_y>0)
then 722 do j=js,je ;
do i=is,ie
723 cs%cfl_cg1_y(i,j) = (dt*cs%cg1(i,j)) * g%IdyT(i,j)
725 call post_data(cs%id_cfl_cg1_y, cs%cfl_cg1_y, cs%diag)
728 if ((cs%id_cg_ebt>0) .or. (cs%id_Rd_ebt>0) .or. (cs%id_p_ebt>0))
then 729 if (cs%id_p_ebt>0)
then 730 call wave_speed(h, tv, g, gv, us, cs%cg1, cs%wave_speed_CSp, use_ebt_mode=.true., &
731 mono_n2_column_fraction=cs%mono_N2_column_fraction, &
732 mono_n2_depth=cs%mono_N2_depth, modal_structure=cs%p_ebt)
733 call post_data(cs%id_p_ebt, cs%p_ebt, cs%diag)
735 call wave_speed(h, tv, g, gv, us, cs%cg1, cs%wave_speed_CSp, use_ebt_mode=.true., &
736 mono_n2_column_fraction=cs%mono_N2_column_fraction, &
737 mono_n2_depth=cs%mono_N2_depth)
739 if (cs%id_cg_ebt>0)
call post_data(cs%id_cg_ebt, cs%cg1, cs%diag)
740 if (cs%id_Rd_ebt>0)
then 742 do j=js,je ;
do i=is,ie
744 f2_h = absurdly_small_freq2 + 0.25 * &
745 ((g%CoriolisBu(i,j)**2 + g%CoriolisBu(i-1,j-1)**2) + &
746 (g%CoriolisBu(i-1,j)**2 + g%CoriolisBu(i,j-1)**2))
747 mag_beta = sqrt(0.5 * ( &
748 (((g%CoriolisBu(i,j)-g%CoriolisBu(i-1,j)) * g%IdxCv(i,j))**2 + &
749 ((g%CoriolisBu(i,j-1)-g%CoriolisBu(i-1,j-1)) * g%IdxCv(i,j-1))**2) + &
750 (((g%CoriolisBu(i,j)-g%CoriolisBu(i,j-1)) * g%IdyCu(i,j))**2 + &
751 ((g%CoriolisBu(i-1,j)-g%CoriolisBu(i-1,j-1)) * g%IdyCu(i-1,j))**2) ))
752 cs%Rd1(i,j) = cs%cg1(i,j) / sqrt(f2_h + cs%cg1(i,j) * mag_beta)
755 call post_data(cs%id_Rd_ebt, cs%Rd1, cs%diag)
759 end subroutine calculate_diagnostic_fields
765 subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p)
766 real,
dimension(:), &
768 real,
intent(in) :: R_in
769 integer,
intent(inout) :: k
771 integer,
intent(in) :: nz
772 real,
intent(out) :: wt
773 real,
intent(out) :: wt_p
780 integer :: k_upper, k_lower, k_new, inc
783 if ((k < 1) .or. (k > nz)) k = nz/2
785 k_upper = k ; k_lower = k ; inc = 1
786 if (r_in < rlist(k))
then 788 k_lower = max(k_lower-inc, 1)
789 if ((k_lower == 1) .or. (r_in >= rlist(k_lower)))
exit 795 k_upper = min(k_upper+inc, nz)
796 if ((k_upper == nz) .or. (r_in < rlist(k_upper)))
exit 802 if ((k_lower == 1) .and. (r_in <= rlist(k_lower)))
then 803 k = 1 ; wt = 1.0 ; wt_p = 0.0
804 elseif ((k_upper == nz) .and. (r_in >= rlist(k_upper)))
then 805 k = nz-1 ; wt = 0.0 ; wt_p = 1.0
808 if (k_upper <= k_lower+1)
exit 809 k_new = (k_upper + k_lower) / 2
810 if (r_in < rlist(k_new))
then 822 wt = (rlist(k_upper) - r_in) / (rlist(k_upper) - rlist(k_lower))
827 end subroutine find_weights
832 subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS)
836 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
840 real,
dimension(:,:),
pointer :: p_surf
846 real,
dimension(SZI_(G), SZJ_(G)) :: &
862 integer :: i, j, k, is, ie, js, je, nz
863 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
865 if (cs%id_mass_wt > 0)
then 866 do j=js,je ;
do i=is,ie ; mass(i,j) = 0.0 ;
enddo ;
enddo 867 do k=1,nz ;
do j=js,je ;
do i=is,ie
868 mass(i,j) = mass(i,j) + gv%H_to_RZ*h(i,j,k)
869 enddo ;
enddo ;
enddo 870 call post_data(cs%id_mass_wt, mass, cs%diag)
873 if (cs%id_temp_int > 0)
then 874 do j=js,je ;
do i=is,ie ; tr_int(i,j) = 0.0 ;
enddo ;
enddo 875 do k=1,nz ;
do j=js,je ;
do i=is,ie
876 tr_int(i,j) = tr_int(i,j) + (gv%H_to_RZ*h(i,j,k))*tv%T(i,j,k)
877 enddo ;
enddo ;
enddo 878 call post_data(cs%id_temp_int, tr_int, cs%diag)
881 if (cs%id_salt_int > 0)
then 882 do j=js,je ;
do i=is,ie ; tr_int(i,j) = 0.0 ;
enddo ;
enddo 883 do k=1,nz ;
do j=js,je ;
do i=is,ie
884 tr_int(i,j) = tr_int(i,j) + (gv%H_to_RZ*h(i,j,k))*tv%S(i,j,k)
885 enddo ;
enddo ;
enddo 886 call post_data(cs%id_salt_int, tr_int, cs%diag)
889 if (cs%id_col_ht > 0)
then 890 call find_eta(h, tv, g, gv, us, z_top)
891 do j=js,je ;
do i=is,ie
892 z_bot(i,j) = z_top(i,j) + g%bathyT(i,j)
894 call post_data(cs%id_col_ht, z_bot, cs%diag)
898 if (cs%id_col_mass > 0 .or. cs%id_pbo > 0)
then 899 do j=js,je ;
do i=is,ie ; mass(i,j) = 0.0 ;
enddo ;
enddo 900 if (gv%Boussinesq)
then 901 if (
associated(tv%eqn_of_state))
then 902 ig_earth = 1.0 / gv%g_Earth
904 do j=g%jscB,g%jecB+1 ;
do i=g%iscB,g%iecB+1
908 do j=g%jscB,g%jecB+1 ;
do i=g%iscB,g%iecB+1
909 z_top(i,j) = z_bot(i,j)
910 z_bot(i,j) = z_top(i,j) - gv%H_to_Z*h(i,j,k)
912 call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), z_top, z_bot, 0.0, gv%Rho0, gv%g_Earth, &
913 g%HI, tv%eqn_of_state, us, dpress)
914 do j=js,je ;
do i=is,ie
915 mass(i,j) = mass(i,j) + dpress(i,j) * ig_earth
919 do k=1,nz ;
do j=js,je ;
do i=is,ie
920 mass(i,j) = mass(i,j) + (gv%H_to_Z*gv%Rlay(k))*h(i,j,k)
921 enddo ;
enddo ;
enddo 924 do k=1,nz ;
do j=js,je ;
do i=is,ie
925 mass(i,j) = mass(i,j) + gv%H_to_RZ*h(i,j,k)
926 enddo ;
enddo ;
enddo 928 if (cs%id_col_mass > 0)
then 929 call post_data(cs%id_col_mass, mass, cs%diag)
931 if (cs%id_pbo > 0)
then 932 do j=js,je ;
do i=is,ie ; btm_pres(i,j) = 0.0 ;
enddo ;
enddo 936 do j=js,je ;
do i=is,ie
937 btm_pres(i,j) = gv%g_Earth * mass(i,j)
938 if (
associated(p_surf))
then 939 btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j)
942 call post_data(cs%id_pbo, btm_pres, cs%diag)
946 end subroutine calculate_vertical_integrals
949 subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS)
952 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
954 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
956 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
958 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
961 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
973 real :: KE_u(SZIB_(G),SZJ_(G))
974 real :: KE_v(SZI_(G),SZJB_(G))
975 real :: KE_h(SZI_(G),SZJ_(G))
977 integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
978 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
979 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
981 do j=js-1,je ;
do i=is-1,ie
982 ke_u(i,j) = 0.0 ; ke_v(i,j) = 0.0
985 if (
associated(cs%KE))
then 986 do k=1,nz ;
do j=js,je ;
do i=is,ie
987 cs%KE(i,j,k) = ((u(i,j,k) * u(i,j,k) + u(i-1,j,k) * u(i-1,j,k)) &
988 + (v(i,j,k) * v(i,j,k) + v(i,j-1,k) * v(i,j-1,k))) * 0.25
992 enddo ;
enddo ;
enddo 993 if (cs%id_KE > 0)
call post_data(cs%id_KE, cs%KE, cs%diag)
996 if (.not.g%symmetric)
then 997 if (
associated(cs%dKE_dt) .OR.
associated(cs%PE_to_KE) .OR.
associated(cs%KE_CorAdv) .OR. &
998 associated(cs%KE_adv) .OR.
associated(cs%KE_visc) .OR.
associated(cs%KE_horvisc).OR. &
999 associated(cs%KE_dia) )
then 1004 if (
associated(cs%dKE_dt))
then 1006 do j=js,je ;
do i=isq,ieq
1007 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * cs%du_dt(i,j,k)
1009 do j=jsq,jeq ;
do i=is,ie
1010 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * cs%dv_dt(i,j,k)
1012 do j=js,je ;
do i=is,ie
1013 ke_h(i,j) = cs%KE(i,j,k) * cs%dh_dt(i,j,k)
1015 if (.not.g%symmetric) &
1016 call do_group_pass(cs%pass_KE_uv, g%domain)
1017 do j=js,je ;
do i=is,ie
1018 cs%dKE_dt(i,j,k) = ke_h(i,j) + 0.5 * g%IareaT(i,j) &
1019 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1022 if (cs%id_dKEdt > 0)
call post_data(cs%id_dKEdt, cs%dKE_dt, cs%diag)
1025 if (
associated(cs%PE_to_KE))
then 1027 do j=js,je ;
do i=isq,ieq
1028 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%PFu(i,j,k)
1030 do j=jsq,jeq ;
do i=is,ie
1031 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%PFv(i,j,k)
1033 if (.not.g%symmetric) &
1034 call do_group_pass(cs%pass_KE_uv, g%domain)
1035 do j=js,je ;
do i=is,ie
1036 cs%PE_to_KE(i,j,k) = 0.5 * g%IareaT(i,j) &
1037 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1040 if (cs%id_PE_to_KE > 0)
call post_data(cs%id_PE_to_KE, cs%PE_to_KE, cs%diag)
1043 if (
associated(cs%KE_CorAdv))
then 1045 do j=js,je ;
do i=isq,ieq
1046 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%CAu(i,j,k)
1048 do j=jsq,jeq ;
do i=is,ie
1049 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%CAv(i,j,k)
1051 do j=js,je ;
do i=is,ie
1052 ke_h(i,j) = -cs%KE(i,j,k) * g%IareaT(i,j) &
1053 * (uh(i,j,k) - uh(i-1,j,k) + vh(i,j,k) - vh(i,j-1,k))
1055 if (.not.g%symmetric) &
1056 call do_group_pass(cs%pass_KE_uv, g%domain)
1057 do j=js,je ;
do i=is,ie
1058 cs%KE_CorAdv(i,j,k) = ke_h(i,j) + 0.5 * g%IareaT(i,j) &
1059 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1062 if (cs%id_KE_Coradv > 0)
call post_data(cs%id_KE_Coradv, cs%KE_Coradv, cs%diag)
1065 if (
associated(cs%KE_adv))
then 1069 ke_u(:,:) = 0. ; ke_v(:,:) = 0.
1071 do j=js,je ;
do i=isq,ieq
1072 if (g%mask2dCu(i,j) /= 0.) &
1073 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%gradKEu(i,j,k)
1075 do j=jsq,jeq ;
do i=is,ie
1076 if (g%mask2dCv(i,j) /= 0.) &
1077 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%gradKEv(i,j,k)
1079 do j=js,je ;
do i=is,ie
1080 ke_h(i,j) = -cs%KE(i,j,k) * g%IareaT(i,j) &
1081 * (uh(i,j,k) - uh(i-1,j,k) + vh(i,j,k) - vh(i,j-1,k))
1083 if (.not.g%symmetric) &
1084 call do_group_pass(cs%pass_KE_uv, g%domain)
1085 do j=js,je ;
do i=is,ie
1086 cs%KE_adv(i,j,k) = ke_h(i,j) + 0.5 * g%IareaT(i,j) &
1087 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1090 if (cs%id_KE_adv > 0)
call post_data(cs%id_KE_adv, cs%KE_adv, cs%diag)
1093 if (
associated(cs%KE_visc))
then 1095 do j=js,je ;
do i=isq,ieq
1096 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%du_dt_visc(i,j,k)
1098 do j=jsq,jeq ;
do i=is,ie
1099 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%dv_dt_visc(i,j,k)
1101 if (.not.g%symmetric) &
1102 call do_group_pass(cs%pass_KE_uv, g%domain)
1103 do j=js,je ;
do i=is,ie
1104 cs%KE_visc(i,j,k) = 0.5 * g%IareaT(i,j) &
1105 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1108 if (cs%id_KE_visc > 0)
call post_data(cs%id_KE_visc, cs%KE_visc, cs%diag)
1111 if (
associated(cs%KE_horvisc))
then 1113 do j=js,je ;
do i=isq,ieq
1114 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%diffu(i,j,k)
1116 do j=jsq,jeq ;
do i=is,ie
1117 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%diffv(i,j,k)
1119 if (.not.g%symmetric) &
1120 call do_group_pass(cs%pass_KE_uv, g%domain)
1121 do j=js,je ;
do i=is,ie
1122 cs%KE_horvisc(i,j,k) = 0.5 * g%IareaT(i,j) &
1123 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1126 if (cs%id_KE_horvisc > 0)
call post_data(cs%id_KE_horvisc, cs%KE_horvisc, cs%diag)
1129 if (
associated(cs%KE_dia))
then 1131 do j=js,je ;
do i=isq,ieq
1132 ke_u(i,j) = uh(i,j,k) * g%dxCu(i,j) * adp%du_dt_dia(i,j,k)
1134 do j=jsq,jeq ;
do i=is,ie
1135 ke_v(i,j) = vh(i,j,k) * g%dyCv(i,j) * adp%dv_dt_dia(i,j,k)
1137 do j=js,je ;
do i=is,ie
1138 ke_h(i,j) = cs%KE(i,j,k) &
1139 * (us%T_to_s * (cdp%diapyc_vel(i,j,k) - cdp%diapyc_vel(i,j,k+1)))
1141 if (.not.g%symmetric) &
1142 call do_group_pass(cs%pass_KE_uv, g%domain)
1143 do j=js,je ;
do i=is,ie
1144 cs%KE_dia(i,j,k) = ke_h(i,j) + 0.5 * g%IareaT(i,j) &
1145 * (ke_u(i,j) + ke_u(i-1,j) + ke_v(i,j) + ke_v(i,j-1))
1148 if (cs%id_KE_dia > 0)
call post_data(cs%id_KE_dia, cs%KE_dia, cs%diag)
1151 end subroutine calculate_energy_diagnostics
1154 subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS)
1155 integer,
intent(in),
dimension(3) :: lb
1156 real,
dimension(lb(1):,lb(2):,:),
target :: f_ptr
1158 real,
dimension(lb(1):,lb(2):,:),
target :: deriv_ptr
1170 if (.not.
associated(cs))
call mom_error(fatal, &
1171 "register_time_deriv: Module must be initialized before it is used.")
1173 if (cs%num_time_deriv >= max_fields_)
then 1174 call mom_error(warning,
"MOM_diagnostics: Attempted to register more than " // &
1175 "MAX_FIELDS_ diagnostic time derivatives via register_time_deriv.")
1179 m = cs%num_time_deriv+1 ; cs%num_time_deriv = m
1181 ub(:) = lb(:) + shape(f_ptr) - 1
1183 cs%nlay(m) =
size(f_ptr, 3)
1184 cs%deriv(m)%p => deriv_ptr
1185 allocate(cs%prev_val(m)%p(lb(1):ub(1), lb(2):ub(2), cs%nlay(m)))
1187 cs%var_ptr(m)%p => f_ptr
1188 cs%prev_val(m)%p(:,:,:) = f_ptr(:,:,:)
1190 end subroutine register_time_deriv
1193 subroutine calculate_derivs(dt, G, CS)
1194 real,
intent(in) :: dt
1201 integer :: i, j, k, m
1203 if (dt > 0.0)
then ; idt = 1.0/dt
1204 else ;
return ;
endif 1215 do m=1,cs%num_time_deriv
1216 do k=1,cs%nlay(m) ;
do j=g%jsc-1,g%jec ;
do i=g%isc-1,g%iec
1217 cs%deriv(m)%p(i,j,k) = (cs%var_ptr(m)%p(i,j,k) - cs%prev_val(m)%p(i,j,k)) * idt
1218 cs%prev_val(m)%p(i,j,k) = cs%var_ptr(m)%p(i,j,k)
1219 enddo ;
enddo ;
enddo 1222 end subroutine calculate_derivs
1227 subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh)
1231 type(
surface),
intent(in) :: sfc_state
1232 real,
dimension(SZI_(G),SZJ_(G)), &
1236 real,
dimension(SZI_(G),SZJ_(G)) :: speed
1237 integer :: i, j, is, ie, js, je
1239 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1241 if (ids%id_ssh > 0) &
1242 call post_data(ids%id_ssh, ssh, diag, mask=g%mask2dT)
1244 if (ids%id_ssu > 0) &
1245 call post_data(ids%id_ssu, sfc_state%u, diag, mask=g%mask2dCu)
1247 if (ids%id_ssv > 0) &
1248 call post_data(ids%id_ssv, sfc_state%v, diag, mask=g%mask2dCv)
1250 if (ids%id_speed > 0)
then 1251 do j=js,je ;
do i=is,ie
1252 speed(i,j) = sqrt(0.5*(sfc_state%u(i-1,j)**2 + sfc_state%u(i,j)**2) + &
1253 0.5*(sfc_state%v(i,j-1)**2 + sfc_state%v(i,j)**2))
1255 call post_data(ids%id_speed, speed, diag, mask=g%mask2dT)
1258 end subroutine post_surface_dyn_diags
1263 subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, &
1270 real,
intent(in) :: dt_int
1271 type(
surface),
intent(in) :: sfc_state
1273 real,
dimension(SZI_(G),SZJ_(G)), &
1275 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: ssh_ibc
1278 real,
dimension(SZI_(G),SZJ_(G)) :: work_2d
1279 real,
dimension(SZI_(G),SZJ_(G)) :: &
1282 real :: zos_area_mean, volo, ssh_ga
1283 integer :: i, j, is, ie, js, je
1285 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1288 if (ids%id_ssh_ga > 0)
then 1289 ssh_ga = global_area_mean(ssh, g)
1290 call post_data(ids%id_ssh_ga, ssh_ga, diag)
1296 if (ids%id_zos > 0 .or. ids%id_zossq > 0)
then 1298 do j=js,je ;
do i=is,ie
1299 zos(i,j) = ssh_ibc(i,j)
1301 zos_area_mean = global_area_mean(zos, g)
1302 do j=js,je ;
do i=is,ie
1303 zos(i,j) = zos(i,j) - g%mask2dT(i,j)*zos_area_mean
1305 if (ids%id_zos > 0)
call post_data(ids%id_zos, zos, diag, mask=g%mask2dT)
1306 if (ids%id_zossq > 0)
then 1307 do j=js,je ;
do i=is,ie
1308 work_2d(i,j) = zos(i,j)*zos(i,j)
1310 call post_data(ids%id_zossq, work_2d, diag, mask=g%mask2dT)
1315 if (ids%id_volo > 0)
then 1316 do j=js,je ;
do i=is,ie
1317 work_2d(i,j) = g%mask2dT(i,j)*(ssh(i,j) + us%Z_to_m*g%bathyT(i,j))
1319 volo = global_area_integral(work_2d, g)
1324 i_time_int = 0.0 ;
if (dt_int > 0.0) i_time_int = 1.0 / dt_int
1327 if (
associated(tv%frazil) .and. (ids%id_fraz > 0))
then 1328 do j=js,je ;
do i=is,ie
1329 work_2d(i,j) = tv%frazil(i,j) * i_time_int
1331 call post_data(ids%id_fraz, work_2d, diag, mask=g%mask2dT)
1335 if (
associated(tv%salt_deficit) .and. (ids%id_salt_deficit > 0))
then 1336 do j=js,je ;
do i=is,ie
1337 work_2d(i,j) = tv%salt_deficit(i,j) * i_time_int
1339 call post_data(ids%id_salt_deficit, work_2d, diag, mask=g%mask2dT)
1343 if (
associated(tv%TempxPmE) .and. (ids%id_Heat_PmE > 0))
then 1344 do j=js,je ;
do i=is,ie
1345 work_2d(i,j) = tv%TempxPmE(i,j) * (tv%C_p * i_time_int)
1347 call post_data(ids%id_Heat_PmE, work_2d, diag, mask=g%mask2dT)
1351 if (
associated(tv%internal_heat) .and. (ids%id_intern_heat > 0))
then 1352 do j=js,je ;
do i=is,ie
1353 work_2d(i,j) = tv%internal_heat(i,j) * (tv%C_p * i_time_int)
1355 call post_data(ids%id_intern_heat, work_2d, diag, mask=g%mask2dT)
1358 if (tv%T_is_conT)
then 1360 if (ids%id_sstcon > 0)
call post_data(ids%id_sstcon, sfc_state%SST, diag, mask=g%mask2dT)
1363 do j=js,je ;
do i=is,ie
1364 work_2d(i,j) = gsw_pt_from_ct(sfc_state%SSS(i,j), sfc_state%SST(i,j))
1366 if (ids%id_sst > 0)
call post_data(ids%id_sst, work_2d, diag, mask=g%mask2dT)
1369 if (ids%id_sst > 0)
call post_data(ids%id_sst, sfc_state%SST, diag, mask=g%mask2dT)
1372 if (tv%S_is_absS)
then 1374 if (ids%id_sssabs > 0)
call post_data(ids%id_sssabs, sfc_state%SSS, diag, mask=g%mask2dT)
1377 do j=js,je ;
do i=is,ie
1378 work_2d(i,j) = gsw_sp_from_sr(sfc_state%SSS(i,j))
1380 if (ids%id_sss > 0)
call post_data(ids%id_sss, work_2d, diag, mask=g%mask2dT)
1383 if (ids%id_sss > 0)
call post_data(ids%id_sss, sfc_state%SSS, diag, mask=g%mask2dT)
1386 if (ids%id_sst_sq > 0)
then 1387 do j=js,je ;
do i=is,ie
1388 work_2d(i,j) = sfc_state%SST(i,j)*sfc_state%SST(i,j)
1390 call post_data(ids%id_sst_sq, work_2d, diag, mask=g%mask2dT)
1392 if (ids%id_sss_sq > 0)
then 1393 do j=js,je ;
do i=is,ie
1394 work_2d(i,j) = sfc_state%SSS(i,j)*sfc_state%SSS(i,j)
1396 call post_data(ids%id_sss_sq, work_2d, diag, mask=g%mask2dT)
1399 call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag))
1401 end subroutine post_surface_thermo_diags
1406 subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dyn, &
1407 diag, dt_trans, Reg)
1411 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(in) :: uhtr
1413 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(in) :: vhtr
1415 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
1420 real,
intent(in) :: dt_trans
1424 real,
dimension(SZIB_(G), SZJ_(G)) :: umo2d
1425 real,
dimension(SZI_(G), SZJB_(G)) :: vmo2d
1426 real,
dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo
1427 real,
dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo
1428 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend
1433 integer :: i, j, k, is, ie, js, je, nz
1434 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
1437 h_to_rz_dt = gv%H_to_RZ * idt
1439 call diag_save_grids(diag)
1440 call diag_copy_storage_to_diag(diag, diag_pre_dyn)
1442 if (ids%id_umo_2d > 0)
then 1444 do k=1,nz ;
do j=js,je ;
do i=is-1,ie
1445 umo2d(i,j) = umo2d(i,j) + uhtr(i,j,k) * h_to_rz_dt
1446 enddo ;
enddo ;
enddo 1447 call post_data(ids%id_umo_2d, umo2d, diag)
1449 if (ids%id_umo > 0)
then 1451 do k=1,nz ;
do j=js,je ;
do i=is-1,ie
1452 umo(i,j,k) = uhtr(i,j,k) * h_to_rz_dt
1453 enddo ;
enddo ;
enddo 1454 call post_data(ids%id_umo, umo, diag, alt_h = diag_pre_dyn%h_state)
1456 if (ids%id_vmo_2d > 0)
then 1458 do k=1,nz ;
do j=js-1,je ;
do i=is,ie
1459 vmo2d(i,j) = vmo2d(i,j) + vhtr(i,j,k) * h_to_rz_dt
1460 enddo ;
enddo ;
enddo 1461 call post_data(ids%id_vmo_2d, vmo2d, diag)
1463 if (ids%id_vmo > 0)
then 1465 do k=1,nz ;
do j=js-1,je ;
do i=is,ie
1466 vmo(i,j,k) = vhtr(i,j,k) * h_to_rz_dt
1467 enddo ;
enddo ;
enddo 1468 call post_data(ids%id_vmo, vmo, diag, alt_h = diag_pre_dyn%h_state)
1471 if (ids%id_uhtr > 0)
call post_data(ids%id_uhtr, uhtr, diag, alt_h = diag_pre_dyn%h_state)
1472 if (ids%id_vhtr > 0)
call post_data(ids%id_vhtr, vhtr, diag, alt_h = diag_pre_dyn%h_state)
1473 if (ids%id_dynamics_h > 0)
call post_data(ids%id_dynamics_h, diag_pre_dyn%h_state, diag, &
1474 alt_h = diag_pre_dyn%h_state)
1476 if (ids%id_dynamics_h_tendency > 0)
then 1478 do k=1,nz ;
do j=js,je ;
do i=is,ie
1479 h_tend(i,j,k) = (h(i,j,k) - diag_pre_dyn%h_state(i,j,k))*idt
1480 enddo ;
enddo ;
enddo 1481 call post_data(ids%id_dynamics_h_tendency, h_tend, diag, alt_h = diag_pre_dyn%h_state)
1484 call post_tracer_transport_diagnostics(g, gv, reg, diag_pre_dyn%h_state, diag)
1486 call diag_restore_grids(diag)
1488 end subroutine post_transport_diagnostics
1492 subroutine mom_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag, CS, tv)
1500 type(time_type),
intent(in) :: time
1506 type(
diag_ctrl),
target,
intent(inout) :: diag
1513 real :: omega, f2_min, convert_h
1515 # include "version_variable.h" 1516 character(len=40) :: mdl =
"MOM_diagnostics" 1517 character(len=48) :: thickness_units, flux_units
1518 real :: wave_speed_min
1519 real :: wave_speed_tol
1520 logical :: better_speed_est
1522 logical :: use_temperature, adiabatic
1523 logical :: default_2018_answers, remap_answers_2018
1524 integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb, nz, nkml, nkbl
1525 integer :: is, ie, js, je, isq, ieq, jsq, jeq, i, j
1527 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1528 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
1529 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke
1530 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1532 if (
associated(cs))
then 1533 call mom_error(warning,
"MOM_diagnostics_init called with an associated "// &
1534 "control structure.")
1540 use_temperature =
associated(tv%T)
1541 call get_param(param_file, mdl,
"ADIABATIC", adiabatic, default=.false., &
1546 call get_param(param_file, mdl,
"DIAG_EBT_MONO_N2_COLUMN_FRACTION", cs%mono_N2_column_fraction, &
1547 "The lower fraction of water column over which N2 is limited as monotonic "// &
1548 "for the purposes of calculating the equivalent barotropic wave speed.", &
1549 units=
'nondim', default=0.)
1550 call get_param(param_file, mdl,
"DIAG_EBT_MONO_N2_DEPTH", cs%mono_N2_depth, &
1551 "The depth below which N2 is limited as monotonic for the "// &
1552 "purposes of calculating the equivalent barotropic wave speed.", &
1553 units=
'm', scale=us%m_to_Z, default=-1.)
1554 call get_param(param_file, mdl,
"INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, &
1555 "The fractional tolerance for finding the wave speeds.", &
1556 units=
"nondim", default=0.001)
1558 call get_param(param_file, mdl,
"INTERNAL_WAVE_SPEED_MIN", wave_speed_min, &
1559 "A floor in the first mode speed below which 0 used instead.", &
1560 units=
"m s-1", default=0.0, scale=us%m_s_to_L_T)
1561 call get_param(param_file, mdl,
"INTERNAL_WAVE_SPEED_BETTER_EST", better_speed_est, &
1562 "If true, use a more robust estimate of the first mode wave speed as the "//&
1563 "starting point for iterations.", default=.false.)
1564 call get_param(param_file, mdl,
"DEFAULT_2018_ANSWERS", default_2018_answers, &
1565 "This sets the default value for the various _2018_ANSWERS parameters.", &
1567 call get_param(param_file, mdl,
"REMAPPING_2018_ANSWERS", remap_answers_2018, &
1568 "If true, use the order of arithmetic and expressions that recover the "//&
1569 "answers from the end of 2018. Otherwise, use updated and more robust "//&
1570 "forms of the same expressions.", default=default_2018_answers)
1572 if (gv%Boussinesq)
then 1573 thickness_units =
"m" ; flux_units =
"m3 s-1" ; convert_h = gv%H_to_m
1575 thickness_units =
"kg m-2" ; flux_units =
"kg s-1" ; convert_h = gv%H_to_kg_m2
1578 cs%id_masscello = register_diag_field(
'ocean_model',
'masscello', diag%axesTL,&
1579 time,
'Mass per unit area of liquid ocean grid cell',
'kg m-2', &
1580 standard_name=
'sea_water_mass_per_unit_area', v_extensive=.true.)
1582 cs%id_masso = register_scalar_field(
'ocean_model',
'masso', time, &
1583 diag,
'Mass of liquid ocean',
'kg', standard_name=
'sea_water_mass')
1585 cs%id_thkcello = register_diag_field(
'ocean_model',
'thkcello', diag%axesTL, time, &
1586 long_name =
'Cell Thickness', standard_name=
'cell_thickness', &
1587 units=
'm', conversion=us%Z_to_m, v_extensive=.true.)
1588 cs%id_h_pre_sync = register_diag_field(
'ocean_model',
'h_pre_sync', diag%axesTL, time, &
1589 long_name =
'Cell thickness from the previous timestep', &
1590 units=
'm', conversion=gv%H_to_m, v_extensive=.true.)
1595 cs%id_volcello = diag_get_volume_cell_measure_dm_id(diag)
1597 if (use_temperature)
then 1598 if (tv%T_is_conT)
then 1599 cs%id_Tpot = register_diag_field(
'ocean_model',
'temp', diag%axesTL, &
1600 time,
'Potential Temperature',
'degC')
1602 if (tv%S_is_absS)
then 1603 cs%id_Sprac = register_diag_field(
'ocean_model',
'salt', diag%axesTL, &
1604 time,
'Salinity',
'psu')
1607 cs%id_tob = register_diag_field(
'ocean_model',
'tob', diag%axesT1, time, &
1608 long_name=
'Sea Water Potential Temperature at Sea Floor', &
1609 standard_name=
'sea_water_potential_temperature_at_sea_floor', units=
'degC')
1610 cs%id_sob = register_diag_field(
'ocean_model',
'sob',diag%axesT1, time, &
1611 long_name=
'Sea Water Salinity at Sea Floor', &
1612 standard_name=
'sea_water_salinity_at_sea_floor', units=
'psu')
1614 cs%id_temp_layer_ave = register_diag_field(
'ocean_model',
'temp_layer_ave', &
1615 diag%axesZL, time,
'Layer Average Ocean Temperature',
'degC')
1616 cs%id_salt_layer_ave = register_diag_field(
'ocean_model',
'salt_layer_ave', &
1617 diag%axesZL, time,
'Layer Average Ocean Salinity',
'psu')
1619 cs%id_thetaoga = register_scalar_field(
'ocean_model',
'thetaoga', &
1620 time, diag,
'Global Mean Ocean Potential Temperature',
'degC',&
1621 standard_name=
'sea_water_potential_temperature')
1622 cs%id_soga = register_scalar_field(
'ocean_model',
'soga', &
1623 time, diag,
'Global Mean Ocean Salinity',
'psu', &
1624 standard_name=
'sea_water_salinity')
1626 cs%id_tosga = register_scalar_field(
'ocean_model',
'sst_global', time, diag,&
1627 long_name=
'Global Area Average Sea Surface Temperature', &
1628 units=
'degC', standard_name=
'sea_surface_temperature', &
1629 cmor_field_name=
'tosga', cmor_standard_name=
'sea_surface_temperature', &
1630 cmor_long_name=
'Sea Surface Temperature')
1631 cs%id_sosga = register_scalar_field(
'ocean_model',
'sss_global', time, diag,&
1632 long_name=
'Global Area Average Sea Surface Salinity', &
1633 units=
'psu', standard_name=
'sea_surface_salinity', &
1634 cmor_field_name=
'sosga', cmor_standard_name=
'sea_surface_salinity', &
1635 cmor_long_name=
'Sea Surface Salinity')
1638 cs%id_u = register_diag_field(
'ocean_model',
'u', diag%axesCuL, time, &
1639 'Zonal velocity',
'm s-1', conversion=us%L_T_to_m_s, cmor_field_name=
'uo', &
1640 cmor_standard_name=
'sea_water_x_velocity', cmor_long_name=
'Sea Water X Velocity')
1641 cs%id_v = register_diag_field(
'ocean_model',
'v', diag%axesCvL, time, &
1642 'Meridional velocity',
'm s-1', conversion=us%L_T_to_m_s, cmor_field_name=
'vo', &
1643 cmor_standard_name=
'sea_water_y_velocity', cmor_long_name=
'Sea Water Y Velocity')
1644 cs%id_h = register_diag_field(
'ocean_model',
'h', diag%axesTL, time, &
1645 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_h)
1647 cs%id_e = register_diag_field(
'ocean_model',
'e', diag%axesTi, time, &
1648 'Interface Height Relative to Mean Sea Level',
'm', conversion=us%Z_to_m)
1649 if (cs%id_e>0)
call safe_alloc_ptr(cs%e,isd,ied,jsd,jed,nz+1)
1651 cs%id_e_D = register_diag_field(
'ocean_model',
'e_D', diag%axesTi, time, &
1652 'Interface Height above the Seafloor',
'm', conversion=us%Z_to_m)
1653 if (cs%id_e_D>0)
call safe_alloc_ptr(cs%e_D,isd,ied,jsd,jed,nz+1)
1655 cs%id_Rml = register_diag_field(
'ocean_model',
'Rml', diag%axesTL, time, &
1656 'Mixed Layer Coordinate Potential Density',
'kg m-3', conversion=us%R_to_kg_m3)
1658 cs%id_Rcv = register_diag_field(
'ocean_model',
'Rho_cv', diag%axesTL, time, &
1659 'Coordinate Potential Density',
'kg m-3', conversion=us%R_to_kg_m3)
1661 cs%id_rhopot0 = register_diag_field(
'ocean_model',
'rhopot0', diag%axesTL, time, &
1662 'Potential density referenced to surface',
'kg m-3', conversion=us%R_to_kg_m3)
1663 cs%id_rhopot2 = register_diag_field(
'ocean_model',
'rhopot2', diag%axesTL, time, &
1664 'Potential density referenced to 2000 dbar',
'kg m-3', conversion=us%R_to_kg_m3)
1665 cs%id_rhoinsitu = register_diag_field(
'ocean_model',
'rhoinsitu', diag%axesTL, time, &
1666 'In situ density',
'kg m-3', conversion=us%R_to_kg_m3)
1667 cs%id_drho_dT = register_diag_field(
'ocean_model',
'drho_dT', diag%axesTL, time, &
1668 'Partial derivative of rhoinsitu with respect to temperature (alpha)',
'kg m-3 degC-1')
1669 cs%id_drho_dS = register_diag_field(
'ocean_model',
'drho_dS', diag%axesTL, time, &
1670 'Partial derivative of rhoinsitu with respect to salinity (beta)',
'kg^2 g-1 m-3')
1672 cs%id_du_dt = register_diag_field(
'ocean_model',
'dudt', diag%axesCuL, time, &
1673 'Zonal Acceleration',
'm s-2', conversion=us%L_T2_to_m_s2)
1674 if ((cs%id_du_dt>0) .and. .not.
associated(cs%du_dt))
then 1675 call safe_alloc_ptr(cs%du_dt,isdb,iedb,jsd,jed,nz)
1676 call register_time_deriv(lbound(mis%u), mis%u, cs%du_dt, cs)
1679 cs%id_dv_dt = register_diag_field(
'ocean_model',
'dvdt', diag%axesCvL, time, &
1680 'Meridional Acceleration',
'm s-2', conversion=us%L_T2_to_m_s2)
1681 if ((cs%id_dv_dt>0) .and. .not.
associated(cs%dv_dt))
then 1682 call safe_alloc_ptr(cs%dv_dt,isd,ied,jsdb,jedb,nz)
1683 call register_time_deriv(lbound(mis%v), mis%v, cs%dv_dt, cs)
1686 cs%id_dh_dt = register_diag_field(
'ocean_model',
'dhdt', diag%axesTL, time, &
1687 'Thickness tendency', trim(thickness_units)//
" s-1", conversion=convert_h*us%s_to_T, v_extensive=.true.)
1688 if ((cs%id_dh_dt>0) .and. .not.
associated(cs%dh_dt))
then 1689 call safe_alloc_ptr(cs%dh_dt,isd,ied,jsd,jed,nz)
1690 call register_time_deriv(lbound(mis%h), mis%h, cs%dh_dt, cs)
1717 cs%id_hf_du_dt_2d = register_diag_field(
'ocean_model',
'hf_dudt_2d', diag%axesCu1, time, &
1718 'Depth-sum Fractional Thickness-weighted Zonal Acceleration',
'm s-2', conversion=us%L_T2_to_m_s2)
1719 if (cs%id_hf_du_dt_2d > 0)
then 1720 if (.not.
associated(cs%du_dt))
then 1721 call safe_alloc_ptr(cs%du_dt,isdb,iedb,jsd,jed,nz)
1722 call register_time_deriv(lbound(mis%u), mis%u, cs%du_dt, cs)
1724 call safe_alloc_ptr(adp%diag_hfrac_u,isdb,iedb,jsd,jed,nz)
1727 cs%id_hf_dv_dt_2d = register_diag_field(
'ocean_model',
'hf_dvdt_2d', diag%axesCv1, time, &
1728 'Depth-sum Fractional Thickness-weighted Meridional Acceleration',
'm s-2', conversion=us%L_T2_to_m_s2)
1729 if (cs%id_hf_dv_dt_2d > 0)
then 1730 if (.not.
associated(cs%dv_dt))
then 1731 call safe_alloc_ptr(cs%dv_dt,isd,ied,jsdb,jedb,nz)
1732 call register_time_deriv(lbound(mis%v), mis%v, cs%dv_dt, cs)
1734 call safe_alloc_ptr(adp%diag_hfrac_v,isd,ied,jsd,jedb,nz)
1739 cs%id_h_Rlay = register_diag_field(
'ocean_model',
'h_rho', diag%axesTL, time, &
1740 'Layer thicknesses in pure potential density coordinates', &
1741 thickness_units, conversion=convert_h)
1742 if (cs%id_h_Rlay>0)
call safe_alloc_ptr(cs%h_Rlay,isd,ied,jsd,jed,nz)
1744 cs%id_uh_Rlay = register_diag_field(
'ocean_model',
'uh_rho', diag%axesCuL, time, &
1745 'Zonal volume transport in pure potential density coordinates', &
1746 flux_units, conversion=us%L_to_m**2*us%s_to_T*convert_h)
1747 if (cs%id_uh_Rlay>0)
call safe_alloc_ptr(cs%uh_Rlay,isdb,iedb,jsd,jed,nz)
1749 cs%id_vh_Rlay = register_diag_field(
'ocean_model',
'vh_rho', diag%axesCvL, time, &
1750 'Meridional volume transport in pure potential density coordinates', &
1751 flux_units, conversion=us%L_to_m**2*us%s_to_T*convert_h)
1752 if (cs%id_vh_Rlay>0)
call safe_alloc_ptr(cs%vh_Rlay,isd,ied,jsdb,jedb,nz)
1754 cs%id_uhGM_Rlay = register_diag_field(
'ocean_model',
'uhGM_rho', diag%axesCuL, time, &
1755 'Zonal volume transport due to interface height diffusion in pure potential '//&
1756 'density coordinates', flux_units, conversion=us%L_to_m**2*us%s_to_T*convert_h)
1757 if (cs%id_uhGM_Rlay>0)
call safe_alloc_ptr(cs%uhGM_Rlay,isdb,iedb,jsd,jed,nz)
1759 cs%id_vhGM_Rlay = register_diag_field(
'ocean_model',
'vhGM_rho', diag%axesCvL, time, &
1760 'Meridional volume transport due to interface height diffusion in pure potential '//&
1761 'density coordinates', flux_units, conversion=us%L_to_m**2*us%s_to_T*convert_h)
1762 if (cs%id_vhGM_Rlay>0)
call safe_alloc_ptr(cs%vhGM_Rlay,isd,ied,jsdb,jedb,nz)
1767 cs%id_KE = register_diag_field(
'ocean_model',
'KE', diag%axesTL, time, &
1768 'Layer kinetic energy per unit mass', &
1769 'm2 s-2', conversion=us%L_T_to_m_s**2)
1770 if (cs%id_KE>0)
call safe_alloc_ptr(cs%KE,isd,ied,jsd,jed,nz)
1772 cs%id_dKEdt = register_diag_field(
'ocean_model',
'dKE_dt', diag%axesTL, time, &
1773 'Kinetic Energy Tendency of Layer', &
1774 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1775 if (cs%id_dKEdt>0)
call safe_alloc_ptr(cs%dKE_dt,isd,ied,jsd,jed,nz)
1777 cs%id_PE_to_KE = register_diag_field(
'ocean_model',
'PE_to_KE', diag%axesTL, time, &
1778 'Potential to Kinetic Energy Conversion of Layer', &
1779 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1780 if (cs%id_PE_to_KE>0)
call safe_alloc_ptr(cs%PE_to_KE,isd,ied,jsd,jed,nz)
1782 cs%id_KE_Coradv = register_diag_field(
'ocean_model',
'KE_Coradv', diag%axesTL, time, &
1783 'Kinetic Energy Source from Coriolis and Advection', &
1784 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1785 if (cs%id_KE_Coradv>0)
call safe_alloc_ptr(cs%KE_Coradv,isd,ied,jsd,jed,nz)
1787 cs%id_KE_adv = register_diag_field(
'ocean_model',
'KE_adv', diag%axesTL, time, &
1788 'Kinetic Energy Source from Advection', &
1789 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1790 if (cs%id_KE_adv>0)
call safe_alloc_ptr(cs%KE_adv,isd,ied,jsd,jed,nz)
1792 cs%id_KE_visc = register_diag_field(
'ocean_model',
'KE_visc', diag%axesTL, time, &
1793 'Kinetic Energy Source from Vertical Viscosity and Stresses', &
1794 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1795 if (cs%id_KE_visc>0)
call safe_alloc_ptr(cs%KE_visc,isd,ied,jsd,jed,nz)
1797 cs%id_KE_horvisc = register_diag_field(
'ocean_model',
'KE_horvisc', diag%axesTL, time, &
1798 'Kinetic Energy Source from Horizontal Viscosity', &
1799 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1800 if (cs%id_KE_horvisc>0)
call safe_alloc_ptr(cs%KE_horvisc,isd,ied,jsd,jed,nz)
1802 if (.not. adiabatic)
then 1803 cs%id_KE_dia = register_diag_field(
'ocean_model',
'KE_dia', diag%axesTL, time, &
1804 'Kinetic Energy Source from Diapycnal Diffusion', &
1805 'm3 s-3', conversion=gv%H_to_m*(us%L_T_to_m_s**2)*us%s_to_T)
1806 if (cs%id_KE_dia>0)
call safe_alloc_ptr(cs%KE_dia,isd,ied,jsd,jed,nz)
1810 cs%id_cg1 = register_diag_field(
'ocean_model',
'cg1', diag%axesT1, time, &
1811 'First baroclinic gravity wave speed',
'm s-1', conversion=us%L_T_to_m_s)
1812 cs%id_Rd1 = register_diag_field(
'ocean_model',
'Rd1', diag%axesT1, time, &
1813 'First baroclinic deformation radius',
'm', conversion=us%L_to_m)
1814 cs%id_cfl_cg1 = register_diag_field(
'ocean_model',
'CFL_cg1', diag%axesT1, time, &
1815 'CFL of first baroclinic gravity wave = dt*cg1*(1/dx+1/dy)',
'nondim')
1816 cs%id_cfl_cg1_x = register_diag_field(
'ocean_model',
'CFL_cg1_x', diag%axesT1, time, &
1817 'i-component of CFL of first baroclinic gravity wave = dt*cg1*/dx',
'nondim')
1818 cs%id_cfl_cg1_y = register_diag_field(
'ocean_model',
'CFL_cg1_y', diag%axesT1, time, &
1819 'j-component of CFL of first baroclinic gravity wave = dt*cg1*/dy',
'nondim')
1820 cs%id_cg_ebt = register_diag_field(
'ocean_model',
'cg_ebt', diag%axesT1, time, &
1821 'Equivalent barotropic gravity wave speed',
'm s-1', conversion=us%L_T_to_m_s)
1822 cs%id_Rd_ebt = register_diag_field(
'ocean_model',
'Rd_ebt', diag%axesT1, time, &
1823 'Equivalent barotropic deformation radius',
'm', conversion=us%L_to_m)
1824 cs%id_p_ebt = register_diag_field(
'ocean_model',
'p_ebt', diag%axesTL, time, &
1825 'Equivalent barotropic modal strcuture',
'nondim')
1827 if ((cs%id_cg1>0) .or. (cs%id_Rd1>0) .or. (cs%id_cfl_cg1>0) .or. &
1828 (cs%id_cfl_cg1_x>0) .or. (cs%id_cfl_cg1_y>0) .or. &
1829 (cs%id_cg_ebt>0) .or. (cs%id_Rd_ebt>0) .or. (cs%id_p_ebt>0))
then 1830 call wave_speed_init(cs%wave_speed_CSp, remap_answers_2018=remap_answers_2018, &
1831 better_speed_est=better_speed_est, min_speed=wave_speed_min, &
1832 wave_speed_tol=wave_speed_tol)
1833 call wave_speed_init(cs%wave_speed_CSp, remap_answers_2018=remap_answers_2018)
1834 call safe_alloc_ptr(cs%cg1,isd,ied,jsd,jed)
1835 if (cs%id_Rd1>0)
call safe_alloc_ptr(cs%Rd1,isd,ied,jsd,jed)
1836 if (cs%id_Rd_ebt>0)
call safe_alloc_ptr(cs%Rd1,isd,ied,jsd,jed)
1837 if (cs%id_cfl_cg1>0)
call safe_alloc_ptr(cs%cfl_cg1,isd,ied,jsd,jed)
1838 if (cs%id_cfl_cg1_x>0)
call safe_alloc_ptr(cs%cfl_cg1_x,isd,ied,jsd,jed)
1839 if (cs%id_cfl_cg1_y>0)
call safe_alloc_ptr(cs%cfl_cg1_y,isd,ied,jsd,jed)
1840 if (cs%id_p_ebt>0)
call safe_alloc_ptr(cs%p_ebt,isd,ied,jsd,jed,nz)
1843 cs%id_mass_wt = register_diag_field(
'ocean_model',
'mass_wt', diag%axesT1, time, &
1844 'The column mass for calculating mass-weighted average properties',
'kg m-2', conversion=us%RZ_to_kg_m2)
1846 if (use_temperature)
then 1847 cs%id_temp_int = register_diag_field(
'ocean_model',
'temp_int', diag%axesT1, time, &
1848 'Density weighted column integrated potential temperature',
'degC kg m-2', conversion=us%RZ_to_kg_m2, &
1849 cmor_field_name=
'opottempmint', &
1850 cmor_long_name=
'integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature',&
1851 cmor_standard_name=
'Depth integrated density times potential temperature')
1853 cs%id_salt_int = register_diag_field(
'ocean_model',
'salt_int', diag%axesT1, time, &
1854 'Density weighted column integrated salinity',
'psu kg m-2', conversion=us%RZ_to_kg_m2, &
1855 cmor_field_name=
'somint', &
1856 cmor_long_name=
'integral_wrt_depth_of_product_of_sea_water_density_and_salinity',&
1857 cmor_standard_name=
'Depth integrated density times salinity')
1860 cs%id_col_mass = register_diag_field(
'ocean_model',
'col_mass', diag%axesT1, time, &
1861 'The column integrated in situ density',
'kg m-2', conversion=us%RZ_to_kg_m2)
1863 cs%id_col_ht = register_diag_field(
'ocean_model',
'col_height', diag%axesT1, time, &
1864 'The height of the water column',
'm', conversion=us%Z_to_m)
1865 cs%id_pbo = register_diag_field(
'ocean_model',
'pbo', diag%axesT1, time, &
1866 long_name=
'Sea Water Pressure at Sea Floor', standard_name=
'sea_water_pressure_at_sea_floor', &
1867 units=
'Pa', conversion=us%RL2_T2_to_Pa)
1869 call set_dependent_diagnostics(mis, adp, cdp, g, cs)
1871 end subroutine mom_diagnostics_init
1875 subroutine register_surface_diags(Time, G, US, IDs, diag, tv)
1876 type(time_type),
intent(in) :: time
1884 ids%id_volo = register_scalar_field(
'ocean_model',
'volo', time, diag,&
1885 long_name=
'Total volume of liquid ocean', units=
'm3', &
1886 standard_name=
'sea_water_volume')
1887 ids%id_zos = register_diag_field(
'ocean_model',
'zos', diag%axesT1, time,&
1888 standard_name =
'sea_surface_height_above_geoid', &
1889 long_name=
'Sea surface height above geoid', units=
'm')
1890 ids%id_zossq = register_diag_field(
'ocean_model',
'zossq', diag%axesT1, time,&
1891 standard_name=
'square_of_sea_surface_height_above_geoid', &
1892 long_name=
'Square of sea surface height above geoid', units=
'm2')
1893 ids%id_ssh = register_diag_field(
'ocean_model',
'SSH', diag%axesT1, time, &
1894 'Sea Surface Height',
'm')
1895 ids%id_ssh_ga = register_scalar_field(
'ocean_model',
'ssh_ga', time, diag,&
1896 long_name=
'Area averaged sea surface height', units=
'm', &
1897 standard_name=
'area_averaged_sea_surface_height')
1898 ids%id_ssu = register_diag_field(
'ocean_model',
'SSU', diag%axesCu1, time, &
1899 'Sea Surface Zonal Velocity',
'm s-1', conversion=us%L_T_to_m_s)
1900 ids%id_ssv = register_diag_field(
'ocean_model',
'SSV', diag%axesCv1, time, &
1901 'Sea Surface Meridional Velocity',
'm s-1', conversion=us%L_T_to_m_s)
1902 ids%id_speed = register_diag_field(
'ocean_model',
'speed', diag%axesT1, time, &
1903 'Sea Surface Speed',
'm s-1', conversion=us%L_T_to_m_s)
1905 if (
associated(tv%T))
then 1906 ids%id_sst = register_diag_field(
'ocean_model',
'SST', diag%axesT1, time, &
1907 'Sea Surface Temperature',
'degC', cmor_field_name=
'tos', &
1908 cmor_long_name=
'Sea Surface Temperature', &
1909 cmor_standard_name=
'sea_surface_temperature')
1910 ids%id_sst_sq = register_diag_field(
'ocean_model',
'SST_sq', diag%axesT1, time, &
1911 'Sea Surface Temperature Squared',
'degC2', cmor_field_name=
'tossq', &
1912 cmor_long_name=
'Square of Sea Surface Temperature ', &
1913 cmor_standard_name=
'square_of_sea_surface_temperature')
1914 ids%id_sss = register_diag_field(
'ocean_model',
'SSS', diag%axesT1, time, &
1915 'Sea Surface Salinity',
'psu', cmor_field_name=
'sos', &
1916 cmor_long_name=
'Sea Surface Salinity', &
1917 cmor_standard_name=
'sea_surface_salinity')
1918 ids%id_sss_sq = register_diag_field(
'ocean_model',
'SSS_sq', diag%axesT1, time, &
1919 'Sea Surface Salinity Squared',
'psu', cmor_field_name=
'sossq', &
1920 cmor_long_name=
'Square of Sea Surface Salinity ', &
1921 cmor_standard_name=
'square_of_sea_surface_salinity')
1922 if (tv%T_is_conT)
then 1923 ids%id_sstcon = register_diag_field(
'ocean_model',
'conSST', diag%axesT1, time, &
1924 'Sea Surface Conservative Temperature',
'Celsius')
1926 if (tv%S_is_absS)
then 1927 ids%id_sssabs = register_diag_field(
'ocean_model',
'absSSS', diag%axesT1, time, &
1928 'Sea Surface Absolute Salinity',
'g kg-1')
1930 if (
associated(tv%frazil))
then 1931 ids%id_fraz = register_diag_field(
'ocean_model',
'frazil', diag%axesT1, time, &
1932 'Heat from frazil formation',
'W m-2', conversion=us%QRZ_T_to_W_m2, &
1933 cmor_field_name=
'hfsifrazil', &
1934 cmor_standard_name=
'heat_flux_into_sea_water_due_to_frazil_ice_formation', &
1935 cmor_long_name=
'Heat Flux into Sea Water due to Frazil Ice Formation')
1939 ids%id_salt_deficit = register_diag_field(
'ocean_model',
'salt_deficit', diag%axesT1, time, &
1940 'Salt sink in ocean due to ice flux', &
1941 'psu m-2 s-1', conversion=us%RZ_T_to_kg_m2s)
1942 ids%id_Heat_PmE = register_diag_field(
'ocean_model',
'Heat_PmE', diag%axesT1, time, &
1943 'Heat flux into ocean from mass flux into ocean', &
1944 'W m-2', conversion=us%QRZ_T_to_W_m2)
1945 ids%id_intern_heat = register_diag_field(
'ocean_model',
'internal_heat', diag%axesT1, time,&
1946 'Heat flux into ocean from geothermal or other internal sources', &
1947 'W m-2', conversion=us%QRZ_T_to_W_m2)
1949 end subroutine register_surface_diags
1952 subroutine register_transport_diags(Time, G, GV, US, IDs, diag)
1953 type(time_type),
intent(in) :: time
1961 character(len=48) :: thickness_units
1963 thickness_units = get_thickness_units(gv)
1964 if (gv%Boussinesq)
then 1965 h_convert = gv%H_to_m
1967 h_convert = gv%H_to_kg_m2
1971 ids%id_uhtr = register_diag_field(
'ocean_model',
'uhtr', diag%axesCuL, time, &
1972 'Accumulated zonal thickness fluxes to advect tracers',
'kg', &
1973 y_cell_method=
'sum', v_extensive=.true., conversion=h_convert*us%L_to_m**2)
1974 ids%id_vhtr = register_diag_field(
'ocean_model',
'vhtr', diag%axesCvL, time, &
1975 'Accumulated meridional thickness fluxes to advect tracers',
'kg', &
1976 x_cell_method=
'sum', v_extensive=.true., conversion=h_convert*us%L_to_m**2)
1977 ids%id_umo = register_diag_field(
'ocean_model',
'umo', &
1978 diag%axesCuL, time,
'Ocean Mass X Transport', &
1979 'kg s-1', conversion=us%RZ_T_to_kg_m2s*us%L_to_m**2, &
1980 standard_name=
'ocean_mass_x_transport', y_cell_method=
'sum', v_extensive=.true.)
1981 ids%id_vmo = register_diag_field(
'ocean_model',
'vmo', &
1982 diag%axesCvL, time,
'Ocean Mass Y Transport', &
1983 'kg s-1', conversion=us%RZ_T_to_kg_m2s*us%L_to_m**2, &
1984 standard_name=
'ocean_mass_y_transport', x_cell_method=
'sum', v_extensive=.true.)
1985 ids%id_umo_2d = register_diag_field(
'ocean_model',
'umo_2d', &
1986 diag%axesCu1, time,
'Ocean Mass X Transport Vertical Sum', &
1987 'kg s-1', conversion=us%RZ_T_to_kg_m2s*us%L_to_m**2, &
1988 standard_name=
'ocean_mass_x_transport_vertical_sum', y_cell_method=
'sum')
1989 ids%id_vmo_2d = register_diag_field(
'ocean_model',
'vmo_2d', &
1990 diag%axesCv1, time,
'Ocean Mass Y Transport Vertical Sum', &
1991 'kg s-1', conversion=us%RZ_T_to_kg_m2s*us%L_to_m**2, &
1992 standard_name=
'ocean_mass_y_transport_vertical_sum', x_cell_method=
'sum')
1993 ids%id_dynamics_h = register_diag_field(
'ocean_model',
'dynamics_h', &
1994 diag%axesTl, time,
'Change in layer thicknesses due to horizontal dynamics', &
1995 'm s-1', v_extensive=.true., conversion=gv%H_to_m)
1996 ids%id_dynamics_h_tendency = register_diag_field(
'ocean_model',
'dynamics_h_tendency', &
1997 diag%axesTl, time,
'Change in layer thicknesses due to horizontal dynamics', &
1998 'm s-1', v_extensive=.true., conversion=gv%H_to_m*us%s_to_T)
2000 end subroutine register_transport_diags
2003 subroutine write_static_fields(G, GV, US, tv, diag)
2008 type(
diag_ctrl),
target,
intent(inout) :: diag
2012 logical :: use_temperature
2014 id = register_static_field(
'ocean_model',
'geolat', diag%axesT1, &
2015 'Latitude of tracer (T) points',
'degrees_north')
2016 if (id > 0)
call post_data(id, g%geoLatT, diag, .true.)
2018 id = register_static_field(
'ocean_model',
'geolon', diag%axesT1, &
2019 'Longitude of tracer (T) points',
'degrees_east')
2020 if (id > 0)
call post_data(id, g%geoLonT, diag, .true.)
2022 id = register_static_field(
'ocean_model',
'geolat_c', diag%axesB1, &
2023 'Latitude of corner (Bu) points',
'degrees_north', interp_method=
'none')
2024 if (id > 0)
call post_data(id, g%geoLatBu, diag, .true.)
2026 id = register_static_field(
'ocean_model',
'geolon_c', diag%axesB1, &
2027 'Longitude of corner (Bu) points',
'degrees_east', interp_method=
'none')
2028 if (id > 0)
call post_data(id, g%geoLonBu, diag, .true.)
2030 id = register_static_field(
'ocean_model',
'geolat_v', diag%axesCv1, &
2031 'Latitude of meridional velocity (Cv) points',
'degrees_north', interp_method=
'none')
2032 if (id > 0)
call post_data(id, g%geoLatCv, diag, .true.)
2034 id = register_static_field(
'ocean_model',
'geolon_v', diag%axesCv1, &
2035 'Longitude of meridional velocity (Cv) points',
'degrees_east', interp_method=
'none')
2036 if (id > 0)
call post_data(id, g%geoLonCv, diag, .true.)
2038 id = register_static_field(
'ocean_model',
'geolat_u', diag%axesCu1, &
2039 'Latitude of zonal velocity (Cu) points',
'degrees_north', interp_method=
'none')
2040 if (id > 0)
call post_data(id, g%geoLatCu, diag, .true.)
2042 id = register_static_field(
'ocean_model',
'geolon_u', diag%axesCu1, &
2043 'Longitude of zonal velocity (Cu) points',
'degrees_east', interp_method=
'none')
2044 if (id > 0)
call post_data(id, g%geoLonCu, diag, .true.)
2046 id = register_static_field(
'ocean_model',
'area_t', diag%axesT1, &
2047 'Surface area of tracer (T) cells',
'm2', conversion=us%L_to_m**2, &
2048 cmor_field_name=
'areacello', cmor_standard_name=
'cell_area', &
2049 cmor_long_name=
'Ocean Grid-Cell Area', &
2050 x_cell_method=
'sum', y_cell_method=
'sum', area_cell_method=
'sum')
2052 call post_data(id, g%areaT, diag, .true.)
2053 call diag_register_area_ids(diag, id_area_t=id)
2056 id = register_static_field(
'ocean_model',
'area_u', diag%axesCu1, &
2057 'Surface area of x-direction flow (U) cells',
'm2', conversion=us%L_to_m**2, &
2058 cmor_field_name=
'areacello_cu', cmor_standard_name=
'cell_area', &
2059 cmor_long_name=
'Ocean Grid-Cell Area', &
2060 x_cell_method=
'sum', y_cell_method=
'sum', area_cell_method=
'sum')
2061 if (id > 0)
call post_data(id, g%areaCu, diag, .true.)
2063 id = register_static_field(
'ocean_model',
'area_v', diag%axesCv1, &
2064 'Surface area of y-direction flow (V) cells',
'm2', conversion=us%L_to_m**2, &
2065 cmor_field_name=
'areacello_cv', cmor_standard_name=
'cell_area', &
2066 cmor_long_name=
'Ocean Grid-Cell Area', &
2067 x_cell_method=
'sum', y_cell_method=
'sum', area_cell_method=
'sum')
2068 if (id > 0)
call post_data(id, g%areaCv, diag, .true.)
2070 id = register_static_field(
'ocean_model',
'area_q', diag%axesB1, &
2071 'Surface area of B-grid flow (Q) cells',
'm2', conversion=us%L_to_m**2, &
2072 cmor_field_name=
'areacello_bu', cmor_standard_name=
'cell_area', &
2073 cmor_long_name=
'Ocean Grid-Cell Area', &
2074 x_cell_method=
'sum', y_cell_method=
'sum', area_cell_method=
'sum')
2075 if (id > 0)
call post_data(id, g%areaBu, diag, .true.)
2077 id = register_static_field(
'ocean_model',
'depth_ocean', diag%axesT1, &
2078 'Depth of the ocean at tracer points',
'm', conversion=us%Z_to_m, &
2079 standard_name=
'sea_floor_depth_below_geoid', &
2080 cmor_field_name=
'deptho', cmor_long_name=
'Sea Floor Depth', &
2081 cmor_standard_name=
'sea_floor_depth_below_geoid', area=diag%axesT1%id_area, &
2082 x_cell_method=
'mean', y_cell_method=
'mean', area_cell_method=
'mean')
2083 if (id > 0)
call post_data(id, g%bathyT, diag, .true., mask=g%mask2dT)
2085 id = register_static_field(
'ocean_model',
'wet', diag%axesT1, &
2086 '0 if land, 1 if ocean at tracer points',
'none', area=diag%axesT1%id_area)
2087 if (id > 0)
call post_data(id, g%mask2dT, diag, .true.)
2089 id = register_static_field(
'ocean_model',
'wet_c', diag%axesB1, &
2090 '0 if land, 1 if ocean at corner (Bu) points',
'none', interp_method=
'none')
2091 if (id > 0)
call post_data(id, g%mask2dBu, diag, .true.)
2093 id = register_static_field(
'ocean_model',
'wet_u', diag%axesCu1, &
2094 '0 if land, 1 if ocean at zonal velocity (Cu) points',
'none', interp_method=
'none')
2095 if (id > 0)
call post_data(id, g%mask2dCu, diag, .true.)
2097 id = register_static_field(
'ocean_model',
'wet_v', diag%axesCv1, &
2098 '0 if land, 1 if ocean at meridional velocity (Cv) points',
'none', interp_method=
'none')
2099 if (id > 0)
call post_data(id, g%mask2dCv, diag, .true.)
2101 id = register_static_field(
'ocean_model',
'Coriolis', diag%axesB1, &
2102 'Coriolis parameter at corner (Bu) points',
's-1', interp_method=
'none', conversion=us%s_to_T)
2103 if (id > 0)
call post_data(id, g%CoriolisBu, diag, .true.)
2105 id = register_static_field(
'ocean_model',
'dxt', diag%axesT1, &
2106 'Delta(x) at thickness/tracer points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2107 if (id > 0)
call post_data(id, g%dxT, diag, .true.)
2109 id = register_static_field(
'ocean_model',
'dyt', diag%axesT1, &
2110 'Delta(y) at thickness/tracer points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2111 if (id > 0)
call post_data(id, g%dyT, diag, .true.)
2113 id = register_static_field(
'ocean_model',
'dxCu', diag%axesCu1, &
2114 'Delta(x) at u points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2115 if (id > 0)
call post_data(id, g%dxCu, diag, .true.)
2117 id = register_static_field(
'ocean_model',
'dyCu', diag%axesCu1, &
2118 'Delta(y) at u points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2119 if (id > 0)
call post_data(id, g%dyCu, diag, .true.)
2121 id = register_static_field(
'ocean_model',
'dxCv', diag%axesCv1, &
2122 'Delta(x) at v points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2123 if (id > 0)
call post_data(id, g%dxCv, diag, .true.)
2125 id = register_static_field(
'ocean_model',
'dyCv', diag%axesCv1, &
2126 'Delta(y) at v points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2127 if (id > 0)
call post_data(id, g%dyCv, diag, .true.)
2129 id = register_static_field(
'ocean_model',
'dyCuo', diag%axesCu1, &
2130 'Open meridional grid spacing at u points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2131 if (id > 0)
call post_data(id, g%dy_Cu, diag, .true.)
2133 id = register_static_field(
'ocean_model',
'dxCvo', diag%axesCv1, &
2134 'Open zonal grid spacing at v points (meter)',
'm', interp_method=
'none', conversion=us%L_to_m)
2135 if (id > 0)
call post_data(id, g%dx_Cv, diag, .true.)
2137 id = register_static_field(
'ocean_model',
'sin_rot', diag%axesT1, &
2138 'sine of the clockwise angle of the ocean grid north to true north',
'none')
2139 if (id > 0)
call post_data(id, g%sin_rot, diag, .true.)
2141 id = register_static_field(
'ocean_model',
'cos_rot', diag%axesT1, &
2142 'cosine of the clockwise angle of the ocean grid north to true north',
'none')
2143 if (id > 0)
call post_data(id, g%cos_rot, diag, .true.)
2148 id = register_static_field(
'ocean_model',
'area_t_percent', diag%axesT1, &
2149 'Percentage of cell area covered by ocean',
'%', conversion=100.0, &
2150 cmor_field_name=
'sftof', cmor_standard_name=
'SeaAreaFraction', &
2151 cmor_long_name=
'Sea Area Fraction', &
2152 x_cell_method=
'mean', y_cell_method=
'mean', area_cell_method=
'mean')
2153 if (id > 0)
call post_data(id, g%mask2dT, diag, .true.)
2156 id = register_static_field(
'ocean_model',
'Rho_0', diag%axesNull, &
2157 'mean ocean density used with the Boussinesq approximation', &
2158 'kg m-3', conversion=us%R_to_kg_m3, cmor_field_name=
'rhozero', &
2159 cmor_standard_name=
'reference_sea_water_density_for_boussinesq_approximation', &
2160 cmor_long_name=
'reference sea water density for boussinesq approximation')
2161 if (id > 0)
call post_data(id, gv%Rho0, diag, .true.)
2163 use_temperature =
associated(tv%T)
2164 if (use_temperature)
then 2165 id = register_static_field(
'ocean_model',
'C_p', diag%axesNull, &
2166 'heat capacity of sea water',
'J kg-1 K-1', conversion=us%Q_to_J_kg, &
2167 cmor_field_name=
'cpocean', &
2168 cmor_standard_name=
'specific_heat_capacity_of_sea_water', &
2169 cmor_long_name=
'specific_heat_capacity_of_sea_water')
2170 if (id > 0)
call post_data(id, tv%C_p, diag, .true.)
2173 end subroutine write_static_fields
2177 subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS)
2190 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz
2191 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed ; nz = g%ke
2192 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
2194 if (
associated(cs%dKE_dt) .or.
associated(cs%PE_to_KE) .or. &
2195 associated(cs%KE_CorAdv) .or.
associated(cs%KE_adv) .or. &
2196 associated(cs%KE_visc) .or.
associated(cs%KE_horvisc) .or. &
2197 associated(cs%KE_dia)) &
2198 call safe_alloc_ptr(cs%KE,isd,ied,jsd,jed,nz)
2200 if (
associated(cs%dKE_dt))
then 2201 if (.not.
associated(cs%du_dt))
then 2202 call safe_alloc_ptr(cs%du_dt,isdb,iedb,jsd,jed,nz)
2203 call register_time_deriv(lbound(mis%u), mis%u, cs%du_dt, cs)
2205 if (.not.
associated(cs%dv_dt))
then 2206 call safe_alloc_ptr(cs%dv_dt,isd,ied,jsdb,jedb,nz)
2207 call register_time_deriv(lbound(mis%v), mis%v, cs%dv_dt, cs)
2209 if (.not.
associated(cs%dh_dt))
then 2210 call safe_alloc_ptr(cs%dh_dt,isd,ied,jsd,jed,nz)
2211 call register_time_deriv(lbound(mis%h), mis%h, cs%dh_dt, cs)
2215 if (
associated(cs%KE_adv))
then 2216 call safe_alloc_ptr(adp%gradKEu,isdb,iedb,jsd,jed,nz)
2217 call safe_alloc_ptr(adp%gradKEv,isd,ied,jsdb,jedb,nz)
2220 if (
associated(cs%KE_visc))
then 2221 call safe_alloc_ptr(adp%du_dt_visc,isdb,iedb,jsd,jed,nz)
2222 call safe_alloc_ptr(adp%dv_dt_visc,isd,ied,jsdb,jedb,nz)
2225 if (
associated(cs%KE_dia))
then 2226 call safe_alloc_ptr(adp%du_dt_dia,isdb,iedb,jsd,jed,nz)
2227 call safe_alloc_ptr(adp%dv_dt_dia,isd,ied,jsdb,jedb,nz)
2230 if (
associated(cs%uhGM_Rlay))
call safe_alloc_ptr(cdp%uhGM,isdb,iedb,jsd,jed,nz)
2231 if (
associated(cs%vhGM_Rlay))
call safe_alloc_ptr(cdp%vhGM,isd,ied,jsdb,jedb,nz)
2233 end subroutine set_dependent_diagnostics
2236 subroutine mom_diagnostics_end(CS, ADp)
2243 if (
associated(cs%e))
deallocate(cs%e)
2244 if (
associated(cs%e_D))
deallocate(cs%e_D)
2245 if (
associated(cs%KE))
deallocate(cs%KE)
2246 if (
associated(cs%dKE_dt))
deallocate(cs%dKE_dt)
2247 if (
associated(cs%PE_to_KE))
deallocate(cs%PE_to_KE)
2248 if (
associated(cs%KE_Coradv))
deallocate(cs%KE_Coradv)
2249 if (
associated(cs%KE_adv))
deallocate(cs%KE_adv)
2250 if (
associated(cs%KE_visc))
deallocate(cs%KE_visc)
2251 if (
associated(cs%KE_horvisc))
deallocate(cs%KE_horvisc)
2252 if (
associated(cs%KE_dia))
deallocate(cs%KE_dia)
2253 if (
associated(cs%dv_dt))
deallocate(cs%dv_dt)
2254 if (
associated(cs%dh_dt))
deallocate(cs%dh_dt)
2255 if (
associated(cs%du_dt))
deallocate(cs%du_dt)
2256 if (
associated(cs%h_Rlay))
deallocate(cs%h_Rlay)
2257 if (
associated(cs%uh_Rlay))
deallocate(cs%uh_Rlay)
2258 if (
associated(cs%vh_Rlay))
deallocate(cs%vh_Rlay)
2259 if (
associated(cs%uhGM_Rlay))
deallocate(cs%uhGM_Rlay)
2260 if (
associated(cs%vhGM_Rlay))
deallocate(cs%vhGM_Rlay)
2262 if (
associated(adp%gradKEu))
deallocate(adp%gradKEu)
2263 if (
associated(adp%gradKEu))
deallocate(adp%gradKEu)
2264 if (
associated(adp%du_dt_visc))
deallocate(adp%du_dt_visc)
2265 if (
associated(adp%dv_dt_visc))
deallocate(adp%dv_dt_visc)
2266 if (
associated(adp%du_dt_dia))
deallocate(adp%du_dt_dia)
2267 if (
associated(adp%dv_dt_dia))
deallocate(adp%dv_dt_dia)
2268 if (
associated(adp%du_other))
deallocate(adp%du_other)
2269 if (
associated(adp%dv_other))
deallocate(adp%dv_other)
2271 if (
associated(adp%diag_hfrac_u))
deallocate(adp%diag_hfrac_u)
2272 if (
associated(adp%diag_hfrac_v))
deallocate(adp%diag_hfrac_v)
2274 do m=1,cs%num_time_deriv ;
deallocate(cs%prev_val(m)%p) ;
enddo 2278 end subroutine mom_diagnostics_end
Calculates the heights of sruface or all interfaces from layer thicknesses.
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Control structure for MOM_wave_speed.
Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means.
Functions for calculating interface heights, including free surface height.
Ocean grid type. See mom_grid for details.
Calculates density of sea water from T, S and P.
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Routines for calculating baroclinic wave speeds.
The MOM6 facility to parse input files for runtime parameters.
Pointers to arrays with accelerations, which can later be used for derived diagnostics,...
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Make a diagnostic available for averaging or output.
A structure with diagnostic IDs of the surface and integrated variables.
Describes various unit conversion factors.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Describes the decomposed MOM domain and has routines for communications across PEs.
Type to carry basic tracer information.
Pointers to arrays with transports, which can later be used for derived diagnostics,...
Routines for error handling and I/O management.
The control structure for the MOM_diagnostics module.
Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM....
Calculate the derivatives of density with temperature and salinity from T, S, and P.
Provides subroutines for quantities specific to the equation of state.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Provides integrals of density.
Set up a group of halo updates.
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Find an accurate and order-invariant sum of a distributed 2d or 3d field.
Provides a transparent vertical ocean grid type and supporting routines.
Provides transparent structures with groups of MOM6 variables and supporting routines.
A structure with diagnostic IDs of mass transport related diagnostics.
An overloaded interface to read and log the values of various types of parameters.
A structure for creating arrays of pointers to 3D arrays.
Calculates any requested diagnostic quantities that are not calculated in the various subroutines....