diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d0a324f96f..d3ad0a0a92 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -14,6 +14,8 @@ module MOM_dynamics_split_RK2 use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_mediator_init, enable_averages use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, register_static_field use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR @@ -344,36 +346,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - ! real, allocatable, dimension(:,:,:) :: & - ! hf_PFu, hf_PFv, & ! Pressure force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_CAu, hf_CAv, & ! Coriolis force accel. x fract. thickness [L T-2 ~> m s-2]. - ! hf_u_BT_accel, hf_v_BT_accel ! barotropic correction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - - real, allocatable, dimension(:,:) :: & - hf_PFu_2d, hf_PFv_2d, & ! Depth integral of hf_PFu, hf_PFv [L T-2 ~> m s-2]. - hf_CAu_2d, hf_CAv_2d, & ! Depth integral of hf_CAu, hf_CAv [L T-2 ~> m s-2]. - hf_u_BT_accel_2d, hf_v_BT_accel_2d ! Depth integral of hf_u_BT_accel, hf_v_BT_accel - - ! Diagnostics for thickness x momentum budget terms - real, allocatable, dimension(:,:,:) :: & - h_PFu, h_PFv, & ! Pressure force accel. x thickness [H L T-2 ~> m2 s-2]. - h_CAu, h_CAv, & ! Coriolis force accel. x thickness [H L T-2 ~> m2 s-2]. - h_u_BT_accel, h_v_BT_accel ! barotropic correction accel. x thickness [H L T-2 ~> m2 s-2]. - - ! Diagnostics for layer-sum of thickness x momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: & - intz_PFu_2d, intz_CAu_2d, intz_u_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: & - intz_PFv_2d, intz_CAv_2d, intz_v_BT_accel_2d ! [H L T-2 ~> m2 s-2]. - - ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], - real, allocatable, dimension(:,:,:) :: & - PFu_visc_rem, PFv_visc_rem, & ! Pressure force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - CAu_visc_rem, CAv_visc_rem, & ! Coriolis force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - u_BT_accel_visc_rem, v_BT_accel_visc_rem ! barotropic correction accel. x visc_rem_[uv] [L T-2 ~> m s-2]. - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf @@ -400,8 +372,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo enddo - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 ! Update CFL truncation value as function of time call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) @@ -918,261 +888,76 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) - endif - - if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) - endif - - - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - !if (CS%id_hf_PFu > 0) then - ! allocate(hf_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFu, hf_PFu, CS%diag) - !endif - !if (CS%id_hf_PFv > 0) then - ! allocate(hf_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_PFv, hf_PFv, CS%diag) - !endif - if (CS%id_intz_PFu_2d > 0) then - intz_PFu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_PFu_2d(I,j) = intz_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFu_2d, intz_PFu_2d, CS%diag) - endif - if (CS%id_intz_PFv_2d > 0) then - intz_PFv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_PFv_2d(i,J) = intz_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_PFv_2d, intz_PFv_2d, CS%diag) - endif - - if (CS%id_hf_PFu_2d > 0) then - allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) + ueffA(:,:,:) = 0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_PFu_2d(I,j) = hf_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k) / up(I,j,k) enddo ; enddo ; enddo - call post_data(CS%id_hf_PFu_2d, hf_PFu_2d, CS%diag) - deallocate(hf_PFu_2d) - endif - if (CS%id_hf_PFv_2d > 0) then - allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_PFv_2d(i,J) = hf_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_PFv_2d, hf_PFv_2d, CS%diag) - deallocate(hf_PFv_2d) + call post_data(CS%id_ueffA, ueffA, CS%diag) endif - if (CS%id_h_PFu > 0) then - allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFu, h_PFu, CS%diag) - deallocate(h_PFu) - endif - if (CS%id_h_PFv > 0) then - allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_PFv, h_PFv, CS%diag) - deallocate(h_PFv) - endif - - !if (CS%id_hf_CAu > 0) then - ! allocate(hf_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAu, hf_CAu, CS%diag) - !endif - !if (CS%id_hf_CAv > 0) then - ! allocate(hf_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_CAv, hf_CAv, CS%diag) - !endif - if (CS%id_intz_CAu_2d > 0) then - intz_CAu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_CAu_2d(I,j) = intz_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAu_2d, intz_CAu_2d, CS%diag) - endif - if (CS%id_intz_CAv_2d > 0) then - intz_CAv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_CAv_2d(i,J) = intz_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_CAv_2d, intz_CAv_2d, CS%diag) - endif - - if (CS%id_hf_CAu_2d > 0) then - allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_CAu_2d(I,j) = hf_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAu_2d, hf_CAu_2d, CS%diag) - deallocate(hf_CAu_2d) - endif - if (CS%id_hf_CAv_2d > 0) then - allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_CAv_2d(i,J) = hf_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_CAv_2d, hf_CAv_2d, CS%diag) - deallocate(hf_CAv_2d) - endif - - if (CS%id_h_CAu > 0) then - allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAu, h_CAu, CS%diag) - deallocate(h_CAu) - endif - if (CS%id_h_CAv > 0) then - allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_CAv, h_CAv, CS%diag) - deallocate(h_CAv) - endif - - !if (CS%id_hf_u_BT_accel > 0) then - ! allocate(hf_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_u_BT_accel, hf_u_BT_accel, CS%diag) - !endif - !if (CS%id_hf_v_BT_accel > 0) then - ! allocate(hf_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_v_BT_accel, hf_v_BT_accel, CS%diag) - !endif - if (CS%id_intz_u_BT_accel_2d > 0) then - intz_u_BT_accel_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_u_BT_accel_2d(I,j) = intz_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_u_BT_accel_2d, intz_u_BT_accel_2d, CS%diag) - endif - if (CS%id_intz_v_BT_accel_2d > 0) then - intz_v_BT_accel_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_v_BT_accel_2d(i,J) = intz_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_v_BT_accel_2d, intz_v_BT_accel_2d, CS%diag) - endif - - if (CS%id_hf_u_BT_accel_2d > 0) then - allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_u_BT_accel_2d(I,j) = hf_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_u_BT_accel_2d, hf_u_BT_accel_2d, CS%diag) - deallocate(hf_u_BT_accel_2d) - endif - if (CS%id_hf_v_BT_accel_2d > 0) then - allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) + if (CS%id_veffA > 0) then + veffA(:,:,:) = 0 do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_v_BT_accel_2d(i,J) = hf_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k) / vp(i,J,k) enddo ; enddo ; enddo - call post_data(CS%id_hf_v_BT_accel_2d, hf_v_BT_accel_2d, CS%diag) - deallocate(hf_v_BT_accel_2d) + call post_data(CS%id_veffA, veffA, CS%diag) endif - if (CS%id_h_u_BT_accel > 0) then - allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_u_BT_accel, h_u_BT_accel, CS%diag) - deallocate(h_u_BT_accel) - endif - if (CS%id_h_v_BT_accel > 0) then - allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_v_BT_accel, h_v_BT_accel, CS%diag) - deallocate(h_v_BT_accel) - endif + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics hf_PFu etc. are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_PFu > 0) call post_product_u(CS%id_hf_PFu, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_PFv > 0) call post_product_v(CS%id_hf_PFv, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_CAu > 0) call post_product_u(CS%id_hf_CAu, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_CAv > 0) call post_product_v(CS%id_hf_CAv, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + !if (CS%id_hf_u_BT_accel > 0) & + ! call post_product_u(CS%id_hf_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_v_BT_accel > 0) & + ! call post_product_v(CS%id_hf_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x prssure force accelerations + if (CS%id_intz_PFu_2d > 0) call post_product_sum_u(CS%id_intz_PFu_2d, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_PFv_2d > 0) call post_product_sum_v(CS%id_intz_PFv_2d, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged prssure force accelerations + if (CS%id_hf_PFu_2d > 0) call post_product_sum_u(CS%id_hf_PFu_2d, CS%PFu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_PFv_2d > 0) call post_product_sum_v(CS%id_hf_PFv_2d, CS%PFv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x prssure force accelerations + if (CS%id_h_PFu > 0) call post_product_u(CS%id_h_PFu, CS%PFu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_PFv > 0) call post_product_v(CS%id_h_PFv, CS%PFv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of Coriolis acceleratations + if (CS%id_intz_CAu_2d > 0) call post_product_sum_u(CS%id_intz_CAu_2d, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_CAv_2d > 0) call post_product_sum_v(CS%id_intz_CAv_2d, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_CAu_2d > 0) call post_product_sum_u(CS%id_hf_CAu_2d, CS%CAu, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_CAv_2d > 0) call post_product_sum_v(CS%id_hf_CAv_2d, CS%CAv, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_CAu > 0) call post_product_u(CS%id_h_CAu, CS%CAu, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_CAv > 0) call post_product_v(CS%id_h_CAv, CS%CAv, CS%ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics of barotropic solver acceleratations + if (CS%id_intz_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_intz_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_intz_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) + if (CS%id_hf_u_BT_accel_2d > 0) & + call post_product_sum_u(CS%id_hf_u_BT_accel_2d, CS%u_accel_bt, CS%ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_v_BT_accel_2d > 0) & + call post_product_sum_v(CS%id_hf_v_BT_accel_2d, CS%v_accel_bt, CS%ADp%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_h_u_BT_accel > 0) & + call post_product_u(CS%id_h_u_BT_accel, CS%u_accel_bt, CS%ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_v_BT_accel > 0) & + call post_product_v(CS%id_h_v_BT_accel, CS%v_accel_bt, CS%ADp%diag_hv, G, nz, CS%diag) - if (CS%id_PFu_visc_rem > 0) then - allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFu_visc_rem, PFu_visc_rem, CS%diag) - deallocate(PFu_visc_rem) - endif - if (CS%id_PFv_visc_rem > 0) then - allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_PFv_visc_rem, PFv_visc_rem, CS%diag) - deallocate(PFv_visc_rem) - endif - if (CS%id_CAu_visc_rem > 0) then - allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAu_visc_rem, CAu_visc_rem, CS%diag) - deallocate(CAu_visc_rem) - endif - if (CS%id_CAv_visc_rem > 0) then - allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_CAv_visc_rem, CAv_visc_rem, CS%diag) - deallocate(CAv_visc_rem) - endif - if (CS%id_u_BT_accel_visc_rem > 0) then - allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_u_BT_accel_visc_rem, u_BT_accel_visc_rem, CS%diag) - deallocate(u_BT_accel_visc_rem) - endif - if (CS%id_v_BT_accel_visc_rem > 0) then - allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_v_BT_accel_visc_rem, v_BT_accel_visc_rem, CS%diag) - deallocate(v_BT_accel_visc_rem) - endif + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_PFu_visc_rem > 0) call post_product_u(CS%id_PFu_visc_rem, CS%PFu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_PFv_visc_rem > 0) call post_product_v(CS%id_PFv_visc_rem, CS%PFv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_CAu_visc_rem > 0) call post_product_u(CS%id_CAu_visc_rem, CS%CAu, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_CAv_visc_rem > 0) call post_product_v(CS%id_CAv_visc_rem, CS%CAv, CS%ADp%visc_rem_v, G, nz, CS%diag) + if (CS%id_u_BT_accel_visc_rem > 0) & + call post_product_u(CS%id_u_BT_accel_visc_rem, CS%u_accel_bt, CS%ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_v_BT_accel_visc_rem > 0) & + call post_product_v(CS%id_v_BT_accel_visc_rem, CS%v_accel_bt, CS%ADp%visc_rem_v, G, nz, CS%diag) if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -1551,7 +1336,6 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive = .true.) - !CS%id_hf_PFu = register_diag_field('ocean_model', 'hf_PFu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Pressure Force Acceleration', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) @@ -1583,13 +1367,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_PFv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Pressure Force Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Pressure Force Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & @@ -1613,13 +1397,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_CAv_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & @@ -1663,13 +1447,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_hf_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & - 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & - 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & @@ -1683,30 +1467,30 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (CS%id_intz_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_PFu_visc_rem = register_diag_field('ocean_model', 'PFu_visc_rem', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_PFu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_CAu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_u_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 439ed242b8..9979ecb5b1 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -9,6 +9,8 @@ module MOM_diagnostics use MOM_coupler_types, only : coupler_type_send_data use MOM_density_integrals, only : int_density_dz use MOM_diag_mediator, only : post_data, get_diag_time_end +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -226,8 +228,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! previous call to diagnostics_init. ! Local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: usq ! squared eastward velocity [L2 T-2 ~> m2 s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vsq ! squared northward velocity [L2 T-2 ~> m2 s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: uv ! u x v at h-points [L2 T-2 ~> m2 s-2] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -238,12 +238,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] - real, allocatable, dimension(:,:) :: & - hf_du_dt_2d, hf_dv_dt_2d ! z integeral of hf_du_dt, hf_dv_dt [L T-2 ~> m s-2]. - - real, allocatable, dimension(:,:,:) :: h_du_dt ! h x dudt [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt ! h x dvdt [H L T-2 ~> m2 s-2] - ! tmp array for surface properties real :: surface_field(SZI_(G),SZJ_(G)) real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] @@ -278,70 +272,32 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) if (CS%id_h_pre_sync > 0) & - call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h = diag_pre_sync%h_state) + call post_data(CS%id_h_pre_sync, diag_pre_sync%h_state, CS%diag, alt_h=diag_pre_sync%h_state) - 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) + 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) - 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) + 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) - 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) + 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) !! Diagnostics for terms multiplied by fractional thicknesses ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. !if (CS%id_hf_du_dt > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt, CS%hf_du_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - !if (CS%id_hf_dv_dt > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt, CS%hf_dv_dt, CS%diag, alt_h = diag_pre_sync%h_state) - !endif - - if (CS%id_hf_du_dt_2d > 0) then - allocate(hf_du_dt_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_du_dt_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - 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) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_2d, hf_du_dt_2d, CS%diag) - deallocate(hf_du_dt_2d) - endif + ! call post_product_u(CS%id_hf_du_dt, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) + !if (CS%id_hf_dv_dt > 0) & + ! call post_product_v(CS%id_hf_dv_dt, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag, alt_h=diag_pre_sync%h_state) - if (CS%id_hf_dv_dt_2d > 0) then - allocate(hf_dv_dt_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dv_dt_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - 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) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_2d, hf_dv_dt_2d, CS%diag) - deallocate(hf_dv_dt_2d) - endif + if (CS%id_hf_du_dt_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_2d, CS%du_dt, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_2d, CS%dv_dt, ADp%diag_hfrac_v, G, nz, CS%diag) - if (CS%id_h_du_dt > 0) then - allocate(h_du_dt(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt(I,j,k) = CS%du_dt(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt, h_du_dt, CS%diag) - deallocate(h_du_dt) - endif - if (CS%id_h_dv_dt > 0) then - allocate(h_dv_dt(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt(i,J,k) = CS%dv_dt(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt, h_dv_dt, CS%diag) - deallocate(h_dv_dt) - endif + if (CS%id_h_du_dt > 0) & + call post_product_u(CS%id_h_du_dt, CS%du_dt, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt > 0) & + call post_product_v(CS%id_h_dv_dt, CS%dv_dt, ADp%diag_hv, G, nz, CS%diag) call diag_restore_grids(CS%diag) @@ -362,24 +318,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) - if (CS%id_usq > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - usq(I,j,k) = u(I,j,k) * u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_usq, usq, CS%diag) - endif + if (CS%id_usq > 0) call post_product_u(CS%id_usq, u, u, G, nz, CS%diag) - if (CS%id_vsq > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vsq(i,J,k) = v(i,J,k) * v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_vsq, vsq, CS%diag) - endif + if (CS%id_vsq > 0) call post_product_v(CS%id_vsq, v, v, G, nz, CS%diag) if (CS%id_uv > 0) then do k=1,nz ; do j=js,je ; do i=is,ie uv(i,j,k) = (0.5*(u(I-1,j,k) + u(I,j,k))) * & - (0.5*(v(i,J-1,k) + v(i,J,k))) + (0.5*(v(i,J-1,k) + v(i,J,k))) enddo ; enddo ; enddo call post_data(CS%id_uv, uv, CS%diag) endif diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 374f54548e..eb24c994f8 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -39,6 +39,7 @@ module MOM_diag_mediator #define MAX_DSAMP_LEV 2 public set_axes_info, post_data, register_diag_field, time_type +public post_product_u, post_product_sum_u, post_product_v, post_product_sum_v public set_masks_for_axes public post_data_1d_k public safe_alloc_ptr, safe_alloc_alloc @@ -1802,6 +1803,108 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) end subroutine post_data_3d_low +!> Calculate and write out diagnostics that are the product of two 3-d arrays at u-points +subroutine post_product_u(id, u_a, u_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz) :: u_prod ! The product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_prod(I,j,k) = u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_u + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at u-points +subroutine post_product_sum_u(id, u_a, u_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_a !< The first u-point array in arbitrary units [A] + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed, nz), & + intent(in) :: u_b !< The second u-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%IsdB:G%IedB, G%jsd:G%jed) :: u_sum ! The vertical sum of the product of u_a and u_b [A B] + integer :: i, j, k + + if (id <= 0) return + + u_sum(:,:) = 0.0 + do k=1,nz ; do j=G%jsc,G%jec ; do I=G%IscB,G%IecB + u_sum(I,j) = u_sum(I,j) + u_a(I,j,k) * u_b(I,j,k) + enddo ; enddo ; enddo + call post_data(id, u_sum, diag) + +end subroutine post_product_sum_u + +!> Calculate and write out diagnostics that are the product of two 3-d arrays at v-points +subroutine post_product_v(id, v_a, v_b, G, nz, diag, mask, alt_h) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask [nondim] + real, target, optional, intent(in) :: alt_h(:,:,:) !< An alternate thickness to use for vertically + !! remapping this diagnostic [H ~> m or kg m-2] + + ! Local variables + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz) :: v_prod ! The product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_prod(i,J,k) = v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_prod, diag, mask=mask, alt_h=alt_h) + +end subroutine post_product_v + +!> Calculate and write out diagnostics that are the vertical sum of the product of two 3-d arrays at v-points +subroutine post_product_sum_v(id, v_a, v_b, G, nz, diag) + integer, intent(in) :: id !< The ID for this diagnostic + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + integer, intent(in) :: nz !< The size of the arrays in the vertical + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_a !< The first v-point array in arbitrary units [A] + real, dimension(G%isd:G%ied, G%JsdB:G%JedB, nz), & + intent(in) :: v_b !< The second v-point array in arbitrary units [B] + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + + real, dimension(G%isd:G%ied, G%JsdB:G%JedB) :: v_sum ! The vertical sum of the product of v_a and v_b [A B] + integer :: i, j, k + + if (id <= 0) return + + v_sum(:,:) = 0.0 + do k=1,nz ; do J=G%JscB,G%JecB ; do i=G%isc,G%iec + v_sum(i,J) = v_sum(i,J) + v_a(i,J,k) * v_b(i,J,k) + enddo ; enddo ; enddo + call post_data(id, v_sum, diag) + +end subroutine post_product_sum_v + !> Post the horizontally area-averaged diagnostic subroutine post_xy_average(diag_cs, diag, field) type(diag_type), intent(in) :: diag !< This diagnostic diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4381af9d84..6a9b49683c 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -6,6 +6,8 @@ module MOM_hor_visc use MOM_checksums, only : hchksum, Bchksum use MOM_coms, only : min_across_PEs use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector, AGRID, BGRID_NE use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe @@ -1662,90 +1664,30 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call post_data(CS%id_FrictWorkIntz, FrictWorkIntz, CS%diag) endif - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (present(ADp) .and. (CS%id_hf_diffu > 0)) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffu, CS%hf_diffu, CS%diag) - !endif - !if (present(ADp) .and. (CS%id_hf_diffv > 0)) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_diffv, CS%hf_diffv, CS%diag) - !endif - if (present(ADp)) then - if (CS%id_hf_diffu_2d > 0) then - hf_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_diffu_2d(I,j) = hf_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffu_2d, hf_diffu_2d, CS%diag) - endif - - if (CS%id_hf_diffv_2d > 0) then - hf_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_diffv_2d(i,J) = hf_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_diffv_2d, hf_diffv_2d, CS%diag) - endif - - if (CS%id_intz_diffu_2d > 0) then - intz_diffu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_diffu_2d(I,j) = intz_diffu_2d(I,j) + diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffu_2d, intz_diffu_2d, CS%diag) - endif - - if (CS%id_intz_diffv_2d > 0) then - intz_diffv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_diffv_2d(i,J) = intz_diffv_2d(i,J) + diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_diffv_2d, intz_diffv_2d, CS%diag) - endif + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_diffu > 0) call post_product_u(CS%id_hf_diffu, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_diffv > 0) call post_product_v(CS%id_hf_diffv, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged momentum budget terms + if (CS%id_hf_diffu_2d > 0) call post_product_sum_u(CS%id_hf_diffu_2d, diffu, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_diffv_2d > 0) call post_product_sum_v(CS%id_hf_diffv_2d, diffv, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for the vertical sum of layer thickness x momentum budget terms + if (CS%id_intz_diffu_2d > 0) call post_product_sum_u(CS%id_intz_diffu_2d, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_intz_diffv_2d > 0) call post_product_sum_v(CS%id_intz_diffv_2d, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for thickness x momentum budget terms + if (CS%id_h_diffu > 0) call post_product_u(CS%id_h_diffu, diffu, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_diffv > 0) call post_product_v(CS%id_h_diffv, diffv, ADp%diag_hv, G, nz, CS%diag) + + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + if (CS%id_diffu_visc_rem > 0) call post_product_u(CS%id_diffu_visc_rem, diffu, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_diffv_visc_rem > 0) call post_product_v(CS%id_diffv_visc_rem, diffv, ADp%visc_rem_v, G, nz, CS%diag) endif - if (present(ADp) .and. (CS%id_h_diffu > 0)) then - allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffu, h_diffu, CS%diag) - deallocate(h_diffu) - endif - if (present(ADp) .and. (CS%id_h_diffv > 0)) then - allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_diffv, h_diffv, CS%diag) - deallocate(h_diffv) - endif - - if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then - allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffu_visc_rem, diffu_visc_rem, CS%diag) - deallocate(diffu_visc_rem) - endif - if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then - allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) - deallocate(diffv_visc_rem) - endif end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). @@ -2467,15 +2409,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) endif CS%id_h_diffu = register_diag_field('ocean_model', 'h_diffu', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffu > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hu,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_h_diffv = register_diag_field('ocean_model', 'h_diffv', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if ((CS%id_h_diffv > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%diag_hv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif @@ -2495,15 +2437,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) endif CS%id_diffu_visc_rem = register_diag_field('ocean_model', 'diffu_visc_rem', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffu_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) endif CS%id_diffv_visc_rem = register_diag_field('ocean_model', 'diffv_visc_rem', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_diffv_visc_rem > 0) .and. (present(ADp))) then call safe_alloc_ptr(ADp%visc_rem_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c0ea3aff53..77ec87b230 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -15,6 +15,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h, diagnoseMLDbyDensityDifference use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, diagnoseMLDbyEnergy, set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_sum_u, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end @@ -2499,24 +2500,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - !! Diagnostics for terms multiplied by fractional thicknesses - if (CS%id_hf_dudt_dia_2d > 0) then - allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_dudt_dia_2d(I,j) = hf_dudt_dia_2d(I,j) + ADp%du_dt_dia(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dudt_dia_2d, hf_dudt_dia_2d, CS%diag) - deallocate(hf_dudt_dia_2d) - endif - - if (CS%id_hf_dvdt_dia_2d > 0) then - allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dvdt_dia_2d(i,J) = hf_dvdt_dia_2d(i,J) + ADp%dv_dt_dia(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dvdt_dia_2d, hf_dvdt_dia_2d, CS%diag) - deallocate(hf_dvdt_dia_2d) - endif + ! Diagnostics for thickness-weighted vertically averaged diapycnal accelerations + if (CS%id_hf_dudt_dia_2d > 0) & + call post_product_sum_u(CS%id_hf_dudt_dia_2d, ADp%du_dt_dia, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dvdt_dia_2d > 0) & + call post_product_sum_v(CS%id_hf_dvdt_dia_2d, ADp%dv_dt_dia, ADp%diag_hfrac_v, G, nz, CS%diag) call disable_averaging(CS%diag) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b332346c6c..adac9e83f4 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -4,23 +4,25 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl -use MOM_debugging, only : uvchksum, hchksum +use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : mech_forcing -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : mech_forcing +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S -use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init -use MOM_PointAccel, only : PointAccel_CS -use MOM_time_manager, only : time_type, time_type_to_real, operator(-) -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type -use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs -use MOM_variables, only : ocean_internal_state -use MOM_verticalGrid, only : verticalGrid_type +use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init +use MOM_PointAccel, only : PointAccel_CS +use MOM_time_manager, only : time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type +use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs +use MOM_variables, only : ocean_internal_state +use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS implicit none ; private @@ -136,11 +138,6 @@ module MOM_vert_friction type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations - ! real, pointer :: hf_du_dt_visc(:,:,:) => NULL() ! Zonal friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, pointer :: hf_dv_dt_visc(:,:,:) => NULL() ! Merdional friction accel. x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - end type vertvisc_CS contains @@ -217,16 +214,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. - real, allocatable, dimension(:,:) :: hf_du_dt_visc_2d ! Depth sum of hf_du_dt_visc [L T-2 ~> m s-2] - real, allocatable, dimension(:,:) :: hf_dv_dt_visc_2d ! Depth sum of hf_dv_dt_visc [L T-2 ~> m s-2] - - real, allocatable, dimension(:,:,:) :: h_du_dt_visc ! h x du_dt_visc [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt_visc ! h x dv_dt_visc [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_du_dt_str ! h x du_dt_str [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: h_dv_dt_str ! h x dv_dt_str [H L T-2 ~> m2 s-2] - real, allocatable, dimension(:,:,:) :: du_dt_str_visc_rem ! du_dt_str x visc_rem_u [L T-2 ~> m s-2] - real, allocatable, dimension(:,:,:) :: dv_dt_str_visc_rem ! dv_dt_str x visc_rem_v [L T-2 ~> m s-2] - logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -525,92 +512,36 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (CS%id_dv_dt_str > 0) & call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) - ! Diagnostics for terms multiplied by fractional thicknesses - - ! 3D diagnostics hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. - !if (CS%id_hf_du_dt_visc > 0) then - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! CS%hf_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_du_dt_visc, CS%hf_du_dt_visc, CS%diag) - !endif - !if (CS%id_hf_dv_dt_visc > 0) then - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! CS%hf_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_dv_dt_visc, CS%hf_dv_dt_visc, CS%diag) - !endif - if (CS%id_hf_du_dt_visc_2d > 0) then - allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_du_dt_visc_2d(I,j) = hf_du_dt_visc_2d(I,j) + ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_du_dt_visc_2d, hf_du_dt_visc_2d, CS%diag) - deallocate(hf_du_dt_visc_2d) - endif - if (CS%id_hf_dv_dt_visc_2d > 0) then - allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_dv_dt_visc_2d(i,J) = hf_dv_dt_visc_2d(i,J) + ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_dv_dt_visc_2d, hf_dv_dt_visc_2d, CS%diag) - deallocate(hf_dv_dt_visc_2d) + if (associated(ADp%du_dt_visc) .and. associated(ADp%du_dt_visc)) then + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_du_dt_visc > 0) & + ! call post_product_u(CS%id_hf_du_dt_visc, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_dv_dt_visc > 0) & + ! call post_product_v(CS%id_hf_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged viscous accelerations + if (CS%id_hf_du_dt_visc_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_visc_2d, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_visc_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_visc_2d, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x viscous accelerations + if (CS%id_h_du_dt_visc > 0) call post_product_u(CS%id_h_du_dt_visc, ADp%du_dt_visc, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_visc > 0) call post_product_v(CS%id_h_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hv, G, nz, CS%diag) endif - if (CS%id_h_du_dt_visc > 0) then - allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt_visc, h_du_dt_visc, CS%diag) - deallocate(h_du_dt_visc) - endif - if (CS%id_h_dv_dt_visc > 0) then - allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt_visc, h_dv_dt_visc, CS%diag) - deallocate(h_dv_dt_visc) - endif - - if (CS%id_h_du_dt_str > 0) then - allocate(h_du_dt_str(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt_str(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_du_dt_str, h_du_dt_str, CS%diag) - deallocate(h_du_dt_str) - endif - if (CS%id_h_dv_dt_str > 0) then - allocate(h_dv_dt_str(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt_str(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_dv_dt_str, h_dv_dt_str, CS%diag) - deallocate(h_dv_dt_str) - endif + if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then + ! Diagnostics for thickness x wind stress acclerations + if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) - if (CS%id_du_dt_str_visc_rem > 0) then - allocate(du_dt_str_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - du_dt_str_visc_rem(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - du_dt_str_visc_rem(I,j,k) = ADp%du_dt_str(I,j,k) * ADp%visc_rem_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_du_dt_str_visc_rem, du_dt_str_visc_rem, CS%diag) - deallocate(du_dt_str_visc_rem) - endif - if (CS%id_dv_dt_str_visc_rem > 0) then - allocate(dv_dt_str_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - dv_dt_str_visc_rem(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - dv_dt_str_visc_rem(i,J,k) = ADp%dv_dt_str(i,J,k) * ADp%visc_rem_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_dv_dt_str_visc_rem, dv_dt_str_visc_rem, CS%diag) - deallocate(dv_dt_str_visc_rem) + ! Diagnostics for wind stress accelerations multiplied by visc_rem_[uv], + if (CS%id_du_dt_str_visc_rem > 0) & + call post_product_u(CS%id_du_dt_str_visc_rem, ADp%du_dt_str, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_dv_dt_str_visc_rem > 0) & + call post_product_v(CS%id_dv_dt_str_visc_rem, ADp%dv_dt_str, ADp%visc_rem_v, G, nz, CS%diag) endif end subroutine vertvisc @@ -1922,7 +1853,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Zonal Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_du_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) !endif @@ -1931,7 +1861,6 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! 'Fractional Thickness-weighted Meridional Acceleration from Vertical Viscosity', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) !if (CS%id_hf_dv_dt_visc > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) !endif @@ -1953,48 +1882,48 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & endif CS%id_h_du_dt_visc = register_diag_field('ocean_model', 'h_du_dt_visc', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) endif CS%id_h_dv_dt_visc = register_diag_field('ocean_model', 'h_dv_dt_visc', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Horizontal Viscosity', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt_visc > 0) then call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif CS%id_h_du_dt_str = register_diag_field('ocean_model', 'h_du_dt_str', diag%axesCuL, Time, & - 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Zonal Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_du_dt_str > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) endif CS%id_h_dv_dt_str = register_diag_field('ocean_model', 'h_dv_dt_str', diag%axesCvL, Time, & - 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', 'm2 s-2', & - conversion=GV%H_to_m*US%L_T2_to_m_s2) + 'Thickness Multiplied Meridional Acceleration from Surface Wind Stresses', & + 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_h_dv_dt_str > 0) then call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) endif CS%id_du_dt_str_visc_rem = register_diag_field('ocean_model', 'du_dt_str_visc_rem', diag%axesCuL, Time, & - 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_str_visc_rem > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) endif CS%id_dv_dt_str_visc_rem = register_diag_field('ocean_model', 'dv_dt_str_visc_rem', diag%axesCvL, Time, & - 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', 'm s-2', & - conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Surface Wind Stresses multiplied by viscous remnant', & + 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_str_visc_rem > 0) then call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(ADp%visc_rem_v,isd,ied,JsdB,JedB,nz)